Reposition cursor in cell that contains the error

[clhare]

I use the following macro to format all cells in a column that should contain only zipcodes. If the cell is blank, contains a space, or contains a non-numeric character, the macro errors out and a message is given. Is there a way to modify this macro so that it will reposition the cursor in the cell that contained the error? There are sometimes thousands of rows in the spreadsheet, so it would be great if the macro could go right to the cell that has a problem.

Sub FormatZipcodes()

 
' Set up the error trap
On Error GoTo ErrHandle

For Each xCell In Selection
    xCell.Value = CDec(xCell.Value)
Next xCell
Selection.NumberFormat = "General"
With Selection
    .HorizontalAlignment = xlRight
    .VerticalAlignment = xlBottom
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With

Exit Sub

ErrHandle:
    MsgBox Prompt:="An error occurred. Check zipcodes for hyphens, spaces, and alpha characters.", _
    Title:="Formatting Error"
    End
End Sub

Thanks for your help!

Cheryl

[JKwan]

is this what you mean?

Sub FormatZipcodes()
     
     
     ' Set up the error trap
    On Error GoTo ErrHandle
     
    For Each xcell In Selection
        xcell.Value = CDec(xcell.Value)
    Next xcell
    Selection.NumberFormat = "General"
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
     
    Exit Sub
     
ErrHandle:
    MsgBox Prompt:="An error occurred. Check zipcodes for hyphens, spaces, and alpha characters.", _
    Title:="Formatting Error"
    xcell.Select  ' <------
    End
End Sub

[clhare]

Exactly what I needed! Thank you so much!

Cheryl

[clhare]

Is it possible to add a message at the end of the macro that shows the range of cells that were formatted? If an error occurs, could the message indicate which cell contained the error?

Cheryl

[JKwan]

Is this what you want?

Sub FormatZipcodes()
    Dim ErrorCells As Range
    
    ' Set up the error trap
    On Error GoTo ErrHandle
    
    For Each xcell In Selection
        xcell.Value = CDec(xcell.Value)
    Next xcell
    Selection.NumberFormat = "General"
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ErrorCells.Select
    Exit Sub
    
ErrHandle:
    If ErrorCells Is Nothing Then
        Set ErrorCells = xcell
    Else
        Set ErrorCells = Union(ErrorCells, xcell)
    End If
    Resume Next
End Sub

[JKwan]

I updated the routine, you may like it better:

Sub FormatZipcodes()
    Dim ErrorCells As Range
    Dim ErrorFound As Boolean
    
     ' Set up the error trap
    On Error GoTo ErrHandle
     
    For Each xcell In Selection
        xcell.Value = CDec(xcell.Value)
    Next xcell
    Selection.NumberFormat = "General"
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    If ErrorFound Then
        MsgBox "Errors found"
        With ErrorCells
            .Select
            .Interior.ColorIndex = 3
        End With
    End If
    Exit Sub
     
ErrHandle:
    ErrorFound = True
    If ErrorCells Is Nothing Then
        Set ErrorCells = xcell
    Else
        Set ErrorCells = Union(ErrorCells, xcell)
    End If
    Resume Next
End Sub

[clhare]

Wow! I do like that! The only issue I see is that the empty cell did not come up as an error. Instead it put a "0" in there. I want it to stay empty and also be highlighted. Is that possible?

[JKwan]

Well, your routine did not handle blanks.... Here is an updated version to handle it

Sub FormatZipcodes()
    Dim ErrorCells As Range
    Dim ErrorFound As Boolean
     
     ' Set up the error trap
    On Error GoTo ErrHandle
     
    For Each xcell In Selection
        If xcell = "" Then
            ErrorFound = True
            If ErrorCells Is Nothing Then
                Set ErrorCells = xcell
            Else
                Set ErrorCells = Union(ErrorCells, xcell)
            End If
        Else
            xcell.Value = CDec(xcell.Value)
        End If
    Next xcell
    Selection.NumberFormat = "General"
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    If ErrorFound Then
        MsgBox "Errors found"
        With ErrorCells
            .Select
            .Interior.ColorIndex = 3
        End With
    End If
    Exit Sub
     
ErrHandle:
    ErrorFound = True
    If ErrorCells Is Nothing Then
        Set ErrorCells = xcell
    Else
        Set ErrorCells = Union(ErrorCells, xcell)
    End If
    Resume Next
End Sub