In support of this post
http://www.excelfox.com/forum/showth...ge41#post12675


Code:
'  http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page41#post12675
Sub NewCmdVNewDD()  '    http://www.eileenslounge.com/viewtopic.php?f=55&t=34247#p265646
Dim Wscmd As Worksheet: Set Wscmd = Worksheets("Command17Marz")
Dim Rngcmd As Range ' dont actually need this, since I make a selection.. but I can use it to check the selection
 Set Rngcmd = Wscmd.Range("D4:E260")
    If Intersect(Rngcmd, Selection) Is Nothing Then MsgBox prompt:="oops": Exit Sub
Dim WsDD As Worksheet: Set WsDD = Worksheets("DDAllComparison")
Dim RngDD As Range
 Set RngDD = WsDD.Range("E4:E680")
Dim ClrIdx As Long: Randomize: Let ClrIdx = (Int(Rnd * 54)) + 3
' take each cell in cmd range and find it in DD range
Dim Rng As Range
    For Each Rng In Selection
        If Rng <> "" Then
        Dim FndRng As Range ' range file cell found in DD
         Set FndRng = RngDD.Find(what:=Rng.Value, After:=RngDD.Cells.Item(1), LookAt:=xlPart, searchorder:=xlNext, MatchCase:=False) '
            If Not FndRng Is Nothing Then ' we have a match that may or may not be the only one in DD, I am assuming it is the only one in cmd, at least in the selection I am using
                Wscmd.Activate: Rng.Select
                Let Rng.Font.ColorIndex = ClrIdx
                Application.Wait (Now + TimeValue("00:00:01"))
                    
                    Do While Not FndRng Is Nothing
                     WsDD.Activate: FndRng.Select
                     Let FndRng.Font.ColorIndex = ClrIdx
                     Application.Wait (Now + TimeValue("00:00:01"))
                     Set FndRng = WsDD.Range("E" & FndRng.Row + 1 & ":E680").Find(what:=Rng.Value, After:=WsDD.Range("E680"), 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
                   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 RngDD ---------------|
End Sub