In support of these threads.
http://www.excelfox.com/forum/showth...ge30#post12493
http://www.excelfox.com/forum/showth...ge33#post12597
Code:
'
Sub CompareDriverFilesDeviceManagerInDoubleDriverAllList2()
Rem 0
If ActiveSheet.Name <> "DeviceManagerProperties" Then
MsgBox prompt:="Oops": Exit Sub
Else
End If
Rem 1 Worksheets info
Dim WsDMP As Worksheet, WsDDA As Worksheet
Set WsDMP = Worksheets("DeviceManagerProperties"): Set WsDDA = Worksheets("DDAllBefore")
Rem 2 Looking at each cell in the selection
' Random number between 3 and 56 to get color index for any matching file names (1 is black, 2 is white , up to 56 is other colors: 3 to 56 is like (0 to 53)+3 Rnd gives like 0-.99999 so (Int(Rnd*54))+3 is what we want
Dim ClrIdx As Long
Randomize: Let ClrIdx = (Int(Rnd * 54)) + 3
Dim SrchForCel As Range
For Each SrchForCel In Selection ' Take each cell in selected range
Dim CelVl As String: Let CelVl = SrchForCel.Value
If CelVl <> "" And Left(CelVl, 3) = "C:\" And InStr(4, CelVl, ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
Dim FileNmeSrchFor As String
Let FileNmeSrchFor = Right(CelVl, (Len(CelVl)) - (InStrRev(CelVl, "\", -1, vbBinaryCompare))) ' Determine the file name as that looking from the right as many characters as (the total character number) - (the position looking from the right of a "\")
Rem 3 We now should have a file name, so we look for it in worksheet DDAllBefore
Dim SrchRng As Range: Set SrchRng = Application.Range("=DDAllBefore!F5:DDAllBefore!G670") ' WsDDA.Range("=F5:G670")
Dim FndCel As Range
Set FndCel = SrchRng.Find(what:=FileNmeSrchFor, After:=Application.Range("=DDAllBefore!F5"), LookAt:=xlPart, searchorder:=xlNext, MatchCase:=False) '
If Not FndCel Is Nothing Then ' the range is set, so the file string has been found in a cell in DDAllBefore
Rem 4 we have two matching cells
'Debug.Print FndCel.Value
'4b) color matching file names in each worksheet, we do the unecerssary activating and selecting so we can see what is going in
WsDMP.Activate: SrchForCel.Select
Application.Wait (Now + TimeValue("00:00:01"))
'Let SrchForCel.Characters(((InStrRev(CelVl, "\", -1, vbBinaryCompare)) + 1), (Len(CelVl)) - (InStrRev(CelVl, "\", -1, vbBinaryCompare))).Font.ColorIndex = ClrIdx
Let SrchForCel.Font.ColorIndex = ClrIdx
WsDDA.Activate: FndCel.Select
Application.Wait (Now + TimeValue("00:00:01"))
Let FndCel.Font.ColorIndex = ClrIdx
Else ' No match was found - the thing in the cell in
End If
Else ' case no file path string in cell
End If
Next SrchForCel
End Sub
For
http://www.excelfox.com/forum/showth...ge30#post12492
Bookmarks