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