Remove all but numbers from cell and cut off numbers after dash
I have a row that contains part of an address example "GILBERT AZ 85234-4512". I want to remove all but the 85234. So remove all characters but numbers and only keep the 5 digit zip.
This needs to be done in a loop because I have 1500+ records. If it's not too much trouble have it remove any left over spaces too.
Unless there is a "-" in the address elsewhere, this should work.
updated: I altered this for cases with no "-" in the zipcodes
Sub findZip() Dim hyphen As String Dim zip As String For Each cell In Range("A2:A1501") hyphen = InStr(1, cell, "-") If hyphen <> 0 Then zip = Trim(Mid(cell, hyphen - 5, 5)) Else: zip = Right(Trim(cell), 5) End If cell.Offset(0, 1) = zip Next End Sub
This would be done most efficiently with a RegExp and a variant array (as range loops can be very slow)
From this article
Sub KillNums() Dim rng1 As Range Dim rngArea As Range Dim lngRow As Long Dim lngCol As Long Dim lngCalc As Long Dim objReg As Object Dim X() On Error Resume Next Set rng1 = Application.InputBox("Select range for the replacement of leading zeros", "User select", Selection.Address, , , , , 8) If rng1 Is Nothing Then Exit Sub On Error GoTo 0 'See Patrick Matthews excellent article on using Regular Expressions with VBA Set objReg = CreateObject("vbscript.regexp") objReg.Pattern = "^.+?(\d+)\-.*$" 'Speed up the code by turning off screenupdating and setting calculation to manual 'Disable any code events that may occur when writing to cells With Application lngCalc = .Calculation .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False End With 'Test each area in the user selected range 'Non contiguous range areas are common when using SpecialCells to define specific cell types to work on For Each rngArea In Intersect(rng1, ActiveSheet.UsedRange).Areas 'The most common outcome is used for the True outcome to optimise code speed If rngArea.Cells.Count > 1 Then 'If there is more than once cell then set the variant array to the dimensions of the range area 'Using Value2 provides a useful speed improvement over Value. On my testing it was 2% on blank cells, up to 10% on non-blanks X = rngArea.Value2 For lngRow = 1 To rngArea.Rows.Count For lngCol = 1 To rngArea.Columns.Count 'replace the leading zeroes X(lngRow, lngCol) = objReg.Replace(X(lngRow, lngCol), "$1") Next lngCol Next lngRow 'Dump the updated array back over the initial range rngArea.Value2 = X Else 'caters for a single cell range area. No variant array required rngArea.Value = objReg.Replace(rngArea.Value, "$1") End If Next rngArea 'cleanup the Application settings With Application .ScreenUpdating = True .Calculation = lngCalc .EnableEvents = True End With Set objReg = Nothing End Sub
A quick way is to select the cells and choose Find-Replace (Ctrl+H).
First replace -* with nothing and then replace * (inc. blank space) with nothing .
This relies on your data being consistently formatted so check the results and use undo/redo if necessary.