In support of this post
http://www.excelfox.com/forum/showth...ge40#post12671

Code:
Option Explicit  '  http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page40#post12671
Sub DDAllEarlier_Marz172020()  '    http://www.eileenslounge.com/viewtopic.php?f=55&t=34247#p265646
Dim WsDDD As Worksheet: Set WsDDD = Worksheets("DDAllComparison")
Dim RngDD1 As Range, RngDD2 As Range  '
 Set RngDD1 = WsDDD.Range("D4:E680"): Set RngDD2 = WsDDD.Range("F4:H680")
' take each cell in column B range and find it in column D, but find next if the text is already coloured
Dim Rng As Range
    For Each Rng In RngDD1 '----------------------| looking at each cell in the newest range, trying to find it in the original range
        If Rng <> "" Then
        Dim ClrIdx As Long: Randomize: Let ClrIdx = (Int(Rnd * 54)) + 3
        Dim FndRng As Range ' FndRng, if found, is in RngDD2 , looking for value in each cell in RngDD1
         Set FndRng = RngDD2.Find(what:=Rng.Value, After:=RngDD2.Cells.Item(1), LookAt:=xlPart, searchorder:=xlNext, MatchCase:=False) '
            If Not FndRng Is Nothing Then ' we have a match that may or may not have already been found.
                Do While Not FndRng Is Nothing ' ===
                    If FndRng.Interior.ColorIndex = -4142 Then  ' case "virgin "white"" text
                     FndRng.Select
                     Let FndRng.Interior.ColorIndex = ClrIdx
                     Application.Wait (Now + TimeValue("00:00:01"))
                     
                     Rng.Select
                     Let Rng.Interior.ColorIndex = ClrIdx
                     Application.Wait (Now + TimeValue("00:00:01"))
                    
                     Set FndRng = Nothing ' This will force the Loop to end after a succesful match
                    Else ' The cell text is already colored, so try again
                     Set FndRng = WsDDD.Range("F" & FndRng.Row + 1 & ":H680").Find(what:=Rng.Value, After:=WsDDD.Range("H680"), LookIn:=xlValues, LookAt:=xlPart, searchorder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)  '   https://stackoverflow.com/questions/49094391/excel-vba-range-findnext-v-range-find-what-have-i-missed/49181464#49181464
                    End If
                Loop ' looping for next match ======
            Else ' no cell value match
            End If
        Else ' case rng has not text in it
        End If
    Next Rng  ' Each Rng In RngDD1 ---------------|
End Sub