Windows 10 and Office Excel

[DocAElstein]

Here is the aborted macro that neeeds to be modified

Sub CompareDriverFilesDoubleDriverInDriverStore() ' http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel?p=12374&viewfull=1#post12374   http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page20#post12374
Rem 0
    If ActiveSheet.Name <> "DDAllBefore" Then
     MsgBox prompt:="Oops": Exit Sub
    Else
    End If
Rem 1 Worksheets info
Dim WsDD As Worksheet, WsDrSt As Worksheet
 Set WsDD = Worksheets("DDAllBefore"): Set WsDrSt = Worksheets("DriverStore")

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. Each should be a cell in DeviceManagerProperties
    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
        If CelVl <> "" And InStr(4, CelVl, ".", vbBinaryCompare) > 1 Then  ' use some criteria to check we have a file
        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 "\")  ---   the characters count left over after the subtraction is equal to the character length of the file name
         Let FileNmeSrchFor = CelVl ' In Double Drivers the cells are not shown as a full path,  so the last line is not necerssary
        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("=DriverStore!D5:DriverStore!F4437")    '
        Dim FndCel As Range: Set FndCel = SrchRng.Find(what:=FileNmeSrchFor, After:=Application.Range("=DriverStore!D5"), 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
            '4a) but we might already have a match,
                If SrchForCel.Font.Color <> 0 Then ' Extra things to do if we already found the cell value in drivers
                 Let ClrIdx = SrchForCel.Font.ColorIndex ' this will make the line below to colorthe text of this cell redundant but will ensure that we use the same color in the DriverStore worksheet rather than the randomly generated one
                 WsDD.Activate: SrchForCel.Select
                 Let SrchForCel.Font.Underline = True
                Else
                End If
            '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
             WsDD.Activate: SrchForCel.Select ' This worksheet will be colured
             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
             Let SrchForCel.Font.Italic = True
             
             WsDrSt.Activate: FndCel.Select ' the other workseet
             Application.Wait (Now + TimeValue("00:00:02"))
             Let FndCel.Font.ColorIndex = ClrIdx
            Else ' No match was found - the thing in the cell in this worksheet is not in the other worksheet
            End If
        Else ' case no file path string in cell
        End If
    Next SrchForCel
End Sub

and this shows the section that need to be included in the new loop

            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
            '4a) but we might already have a match,
                If SrchForCel.Font.Color <> 0 Then ' Extra things to do if we already found the cell value in drivers
                 Let ClrIdx = SrchForCel.Font.ColorIndex ' this will make the line below to colorthe text of this cell redundant but will ensure that we use the same color in the DriverStore worksheet rather than the randomly generated one
                 WsDD.Activate: SrchForCel.Select
                 Let SrchForCel.Font.Underline = True
                Else
                End If
            '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
             WsDD.Activate: SrchForCel.Select ' This worksheet will be colured
             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
             Let SrchForCel.Font.Italic = True
             
             WsDrSt.Activate: FndCel.Select ' the other workseet
             Application.Wait (Now + TimeValue("00:00:02"))
             Let FndCel.Font.ColorIndex = ClrIdx
            
            
            Else ' No match was found - the thing in the cell in this worksheet is not in the other worksheet
            End If

and this shows the section that need to be included in the new loop

            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
            '4a) but we might already have a match,
                If SrchForCel.Font.Color <> 0 Then ' Extra things to do if we already found the cell value in drivers
                 Let ClrIdx = SrchForCel.Font.ColorIndex ' this will make the line below to colorthe text of this cell redundant but will ensure that we use the same color in the DriverStore worksheet rather than the randomly generated one
                 WsDD.Activate: SrchForCel.Select
                 Let SrchForCel.Font.Underline = True
                Else
                End If
            '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
             WsDD.Activate: SrchForCel.Select ' This worksheet will be colured
             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
             Let SrchForCel.Font.Italic = True
             
             WsDrSt.Activate: FndCel.Select ' the other workseet
             Application.Wait (Now + TimeValue("00:00:02"))
             Let FndCel.Font.ColorIndex = ClrIdx
                      
            Else ' No match was found - the thing in the cell in this worksheet is not in the other worksheet
            End If