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




Reply With Quote
Bookmarks