VBA finds only 1 match/occurence

Kensain 0
Viewed 52

I need help with the script below. I need to highlight all cells in range(r) which contain values from another range(dictionary), but currently it only highlights first occurrences of each cell in the dictionary range.

Sub SearchAndFormat_Click()   
    Dim Dictionary As Variant
    Dictionary = Range("L5:L9")
    
    Dim r As Range, cell As Variant
    Set r = Application.InputBox("Select range", "Selection Window", Type:=8)
    r.ClearFormats
    r.NumberFormat = "General"
    
    For Each subj In Dictionary
        For Each cell In r
            Set target_cell = r.Find(subj, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
            If Not target_cell Is Nothing Then
                target_cell.Interior.ColorIndex = 4
            End If
        Next
    Next
End Sub

I used to have a version of code without nested loop, but it would only highlight the first occurrence of the first value in the dictionary range:

For Each cell In r
    Set target_cell = r.Find(Dictionary, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    If Not target_cell Is Nothing Then
        target_cell.Interior.ColorIndex = 4
    End If
Next

Any help is greatly appreciated!

vba loops excel
1 Answers

If you use Find in order find all values equal to the target, then it should be sort of a Do ... Loop with active use of a parameter After:=... For example:

Set x = MyRange.Find(target)
If Not x Is Nothing Then
   Start = x.Address
   Do
      Debug.Print x.Address, x.Value
      Set x = MyRange.FindNext(After:=x)
   Loop While x.Address <> Start
End If

But there's no need to use Find when you loop through each value in a dictionary and in a range of interest:

Sub test_colorizing()
Dim d As Range
Dim r As Range
Dim x, y
    Set d = Range(...)   ' Dictionary
    Set r = Range(...)   ' Range of interest
    For Each x In r
        For Each y In d
            If x = y Then
                x.Interior.ColorIndex = 4
                Exit For   ' go to the next word in r
            End If
        Next
    Next
End Sub

How it can look with Find:

Sub test_colorizing_with_find()
Dim dict As Range    ' Dictionary
Dim rng As Range     ' Range of interest
Dim cell, word, start
    Set dict = Range(...)
    Set rng = Range(...)
    For Each word In dict
        Set cell = rng.Find(word)
        If Not cell Is Nothing Then
            start = cell.Address
            Do
               cell.Interior.ColorIndex = 4
               Set cell = rng.FindNext(cell)
            Loop While cell.Address <> start
        End If
    Next
End Sub
Vitalizzare0
Related