2

I have code which looks through an Excel table.

Sub ErrorCheck()
    Dim ErrColl As New Collection
    Dim NameColl As New Collection
    Worksheets(WorksheetName).Select           
    Worksheets(WorksheetName).Range("B5").Select
    Do Until IsEmpty(ActiveCell)
        On Error Goto eh
        NameColl.Add ActiveCell.Value
        ActiveCell.Offset(0, 1).Select
    Loop
    eh:
       ErrColl.Add ActiveCell.Value
End Sub

The above will stop once a duplicate occurs. I don't want the code to stop when a duplicate occurs, because I need all the duplicates to be shown in msgbox/logged onto a file. 'Resume next' will give me the right answer with no duplicates, but will not show the where the duplicates are. 'GoTo' will only show the first error. Is there another way to do this?

braX
  • 11,506
  • 5
  • 20
  • 33
joshSS
  • 23
  • 3
  • 2
    You can do more with error handling than that. https://stackoverflow.com/questions/1038006/good-patterns-for-vba-error-handling – braX Apr 22 '21 at 02:03
  • Fyi See [VBA Error handler that emails me](https://stackoverflow.com/questions/51895607/vba-error-handler-that-emails-me-when-errors-occur/52035103#52035103) with additional check for the code line raising the error :-) @joshSS – T.M. Apr 22 '21 at 14:42

2 Answers2

1

You can always combine ´On Error Resume Next´ with a check of the Error code. The following (very silly) code should illustrate how this works:

On Error Resume Next

Dim i As Integer
Dim m As Integer
Dim n As Double


For i = 1 To 10

    m = i Mod 3
    n = i / m
    If Err.Number > 0 Then
        MsgBox ("Handle error here")
        Err.Number = 0
    Else
        MsgBox ("n: " + Str(n))
    End If
Next

What this is doing is to test for the Error code on the line after the error is likely to occur. If there was no error (Err.Number = 0), the code continues with the Else. If an error has been raised (in this case Err.Number = 11 - division by zero when i is 3, 6 and 9), then you can handle the error within the If and the code continues after the End If. Notice that you need to reset the Err.Number back to 0!

Jonathan Willcock
  • 5,012
  • 3
  • 20
  • 31
0

I wouldn't select stuff so much because it will slow your code down.

Anyway, here's something that might be of use. Change the code where necessary.

Sub ErrorCheck()
    Dim rCell As Range
    Dim lRow As Long
    Dim rCheck
    
    With Worksheets(1) 'change to suit
        
        Set rCell = .Cells(5, 2)
        
        Set rCheck = rCell
        
        lRow = 1
        
        Do Until rCell(lRow).Value = vbNullString
        
            Set rCheck = Union(rCheck, rCell.Offset(lRow))
            
            With rCell.Offset(lRow)
            
                If WorksheetFunction.CountIf(rCheck, .Value) > 1 Then
                        
                    Debug.Print .Address & vbTab & .Value 'using the Immediate Window as an example
                                        
                End If
            
            End With
            
            lRow = lRow + 1
            
        Loop
        
    End With
    
    Set rCell = Nothing
    
    Set rCheck = Nothing
    
End Sub
Andrew
  • 221
  • 1
  • 10