In support of these posts
http://www.excelfox.com/forum/showth...ge40#post12669
http://www.eileenslounge.com/viewtop...=34247#p265646
Code:' _ Marz 2020 Sub DeviceManagerPropertiesMarz172020() ' http://www.eileenslounge.com/viewtopic.php?f=55&t=34247#p265646 Dim WsDMP As Worksheet: Set WsDMP = Worksheets("DeviceManagerProperties") Dim rngDMP1 As Range, rngDMP2 As Range ' B1:F550 G1:J550 Set rngDMP1 = WsDMP.Range("B5:F550"): Set rngDMP2 = WsDMP.Range("G5:J550") ' take each cell in range for original DMP and find it in range for new DMP but find next if the interior is already coloured Dim Rng As Range For Each Rng In rngDMP1 '----------------------| If Rng <> "" Then Dim ClrIdx As Long: Randomize: Let ClrIdx = (Int(Rnd * 54)) + 3 Dim FndRng As Range Set FndRng = rngDMP2.Find(what:=Rng.Value, After:=rngDMP2.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 already has background color, so try again from next row Set FndRng = WsDMP.Range("G" & FndRng.Row + 1 & ":J550").Find(what:=Rng.Value, After:=WsDMP.Range("J550"), 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 '------------------------------------| End Sub
ExplorerBefore DeviceManager Earlier and Marz17 2020.xlsm : https://app.box.com/s/gsgwwbqggel397ufnruegjyfst51p3g6




Reply With Quote
Bookmarks