VBA finds only 1 match/occurence - excel

Question

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!

Answer 1

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