Find multiple values in Excel VBA

Question

I want to highlight all accuring values in a excel file. My code however only highlights the first found value for every sheet, but I want to highlight every found value. I guess the ``FindNext'' does not work as i expect it to work. I tried multple other examples from the internet, which show the same result. What is going wrong?

Sub test()

    Dim counter As Integer
    Dim currentSheet As Integer
    Dim cell As Range

    On Error Resume Next

    currentSheet = ActiveSheet.Index

    datatoFind = StrConv(InputBox("Please enter the value to search for"), vbLowerCase)

    If datatoFind = "" Then Exit Sub

    sheetCount = ActiveWorkbook.Sheets.Count

    If IsError(CDbl(datatoFind)) = False Then datatoFind = CDbl(datatoFind)
    For counter = 1 To sheetCount
        Sheets(counter).Activate

        Set cell = Cells.Find(What:=datatoFind, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)

        If Not cell Is Nothing Then
            FirstAddress = cell.Address
            Do
                cell.Interior.Color = RGB(255, 0, 0)
                cell = Cells.FindNext(After:=cell)
            Loop Until cell.Address = FirstAddress
        End If

    Next counter

End Sub

try to change `cell = Cells.FindNext(After:=cell)` to `Set cell = Cells.FindNext(After:=cell)` — Dmitry Pavliv, Apr 03 '14 at 09:12
and alos interesting read for you: [Why I should use On Error Resume Next judiciously](http://stackoverflow.com/questions/21673529/if-not-function-proceeds-when-value-is-the-one-specified/21673617#21673617) — Dmitry Pavliv, Apr 03 '14 at 09:14

score 3 · Accepted Answer · edited May 23 '17 at 10:33

As follow up from comments this one works (code slighlty improved):

Sub test()
    Dim cell As Range
    Dim ws As Worksheet
    Dim datatoFind
    Dim FirstAddress As String

    datatoFind = StrConv(InputBox("Please enter the value to search for"), vbLowerCase)
    If datatoFind = "" Then Exit Sub
    If IsNumeric(datatoFind) Then datatoFind = CDbl(datatoFind)

    For Each ws In ActiveWorkbook.Worksheets
        With ws.Cells
            Set cell = .Find(What:=datatoFind, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, _
                            MatchCase:=False, SearchFormat:=False)

            If Not cell Is Nothing Then
                FirstAddress = cell.Address
                Do
                    cell.Interior.Color = RGB(255, 0, 0)
                    Set cell = .FindNext(cell)
                    If cell Is Nothing Then Exit Do
                Loop Until cell.Address = FirstAddress
            End If
        End With
    Next ws
End Sub

Your Loop Until cell.Address = FirstAddress triggers an error when cell is nothing, that's why I added If cell Is Nothing Then Exit Do (You don't see this error messages because you're using On Error Resume Next)

Also two interesting reads for you:

Find multiple values in Excel VBA

1 Answers1