In support of this post.
http://www.excelfox.com/forum/showth...ge40#post12672
Code:
Sub DDAllEarlier_Marz172020() ' http://www.eileenslounge.com/viewtopic.php?f=55&t=34247#p265646
Dim Wsdrs As Worksheet: Set Wsdrs = Worksheets("drivers marz 2020") ' C2:E180 F2:H180
Dim Rngdr1 As Range, Rngdr2 As Range '
Set Rngdr1 = Wsdrs.Range("F2:H180"): Set Rngdr2 = Wsdrs.Range("C2:E180") ' A bit back to front 1 is right columns original , 2 is left columns new from Marz 2020
' 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 Rngdr2 '----------------------| 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 = Rngdr1.Find(what:=Rng.Value, After:=Rngdr1.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 = Wsdrs.Range("F" & FndRng.Row + 1 & ":H180").Find(what:=Rng.Value, After:=Wsdrs.Range("H180"), 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 Rngdr2 ---------------|
End Sub
Bookmarks