1

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.

0

3 Answers 3

1

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
0

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
1
  • it says "run time error '5': invalid procedure call or argument" when it gets to "zip = Mid(cell, hyphen - 5, 5)"
    – jardane
    Jun 7, 2012 at 17:10
0

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.

2
  • I need it in VBS so i can write a macro
    – jardane
    Jun 7, 2012 at 16:12
  • Ah, I see you just added vbscript to the question. I haven't used vbs, in VBA I would use the split function with " " and then "-" as delimiter to retrieve the zip code.
    – lori_m
    Jun 7, 2012 at 16:16

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.