Appendix Thread. 3 TEST COPY

**DocAElstein** · 03-09-2020, 01:51 AM

In support of this Thread
http://www.excelfox.com/forum/showth...ge29#post12481

Code:

Sub FileTypesHereDoubleDriverFull_Clamers_SquareBrackets()
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = Me
Dim Rng As Range: Set Rng = Ws.Range("F5:G670")
'Dim arrFiles() As Variant: Let arrFiles() = Rng.Value2
Rem 2 File extension types
Dim Ddl As Long, Sys As Long, Bin As Long, Cpa As Long, Vp As Long, Els As Long
Dim Inf As Long, Ini As Long, Cat As Long, Gpd As Long, Xml As Long, Gdl As Long
Dim Ddl2 As Long, Sys2 As Long, Bin2 As Long, Cpa2 As Long, Vp2 As Long, Els2 As Long
Dim Inf2 As Long, Ini2 As Long, Cat2 As Long, Gpd2 As Long, Xml2 As Long, Gdl2 As Long
Dim Ddl3 As Long, Sys3 As Long, Bin3 As Long, Cpa3 As Long, Vp3 As Long, Els3 As Long
Dim Inf3 As Long, Ini3 As Long, Cat3 As Long, Gpd3 As Long, Xml3 As Long, Gdl3 As Long
Dim Js As Long, Dpd As Long, Ppd As Long, Cab As Long, Bag As Long, Exe As Long
Dim Js2 As Long, Dpd2 As Long, Ppd2 As Long, Cab2 As Long, Bag2 As Long, Exe2 As Long
Dim Js3 As Long, Dpd3 As Long, Ppd3 As Long, Cab3 As Long, Bag3 As Long, Exe3 As Long
Dim Dpb As Long
Dim Dpb2 As Long
Dim Dpb3 As Long
Rem 3 Looping
'Dim ClCnt As Long, RwCnt As Long
Dim rngStr As Range ' a single cell to use as a stear element in the For Next loop
    For Each rngStr In Rng
'    For RwCnt = 1 To UBound(arrFiles(), 1)
'        For ClCnt = 1 To UBound(arrFiles(), 2)
            'If arrFiles(RwCnt, ClCnt) = "" Then
            If rngStr.Value = "" Then
            ' Empty cell, so do nothing
            Else ' Time to look at cell value
                'If Left(arrFiles(RwCnt, ClCnt), 3) = "C:\" And InStr(4, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
                'If Left(RngStr.Value, 3) = "C:\" And InStr(4, RngStr.Value, ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
                If InStr(2, rngStr.Value, ".", vbBinaryCompare) > 1 Then  ' use some criteria to check we have a file path
                ' Get the extension
                Dim Xtn As String
                'Let Xtn = Mid(arrFiles(RwCnt, ClCnt), (InStr(4, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) + 1))
                 Let Xtn = Mid(rngStr.Value, (InStr(2, rngStr.Value, ".", vbBinaryCompare) + 1))
                    Select Case UCase(Xtn)
                     Case "SYS"
                      Let Sys = Sys + 1: If rngStr.Font.Color <> 0 Then Let Sys2 = Sys2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Sys3 = Sys3 + 1
                     Case "DLL"
                      Let Ddl = Ddl + 1: If rngStr.Font.Color <> 0 Then Let Ddl2 = Ddl2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Ddl3 = Ddl3 + 1
                     Case "BIN"
                      Let Bin = Bin + 1: If rngStr.Font.Color <> 0 Then Let Bin2 = Bin2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Bin3 = Bin3 + 1
                     Case "CPA"
                      Let Cpa = Cpa + 1: If rngStr.Font.Color <> 0 Then Let Cpa2 = Cpa2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Cpa3 = Cpa3 + 1
                     Case "VP"
                      Let Vp = Vp + 1: If rngStr.Font.Color <> 0 Then Let Vp2 = Vp2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Vp3 = Vp3 + 1
                     ' Inf As Long, Ini As Long, Cat As Long, Gpd As Long, Xml As Long, Gdl As Long
                      Case "INF"
                      Let Inf = Inf + 1: If rngStr.Font.Color <> 0 Then Let Inf2 = Inf2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Inf3 = Inf3 + 1
                     Case "INI"
                      Let Ini = Ini + 1: If rngStr.Font.Color <> 0 Then Let Ini2 = Ini2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Ini3 = Ini3 + 1
                     Case "CAT"
                      Let Cat = Cat + 1: If rngStr.Font.Color <> 0 Then Let Cat2 = Cat2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Cat3 = Cat3 + 1
                     Case "GPD"
                      Let Gpd = Gpd + 1: If rngStr.Font.Color <> 0 Then Let Gpd2 = Gpd2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Gpd3 = Gpd3 + 1
                     Case "XML"
                      Let Xml = Xml + 1: If rngStr.Font.Color <> 0 Then Let Xml2 = Xml2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Xml3 = Xml3 + 1
                     Case "GDL"
                      Let Gdl = Gdl + 1: If rngStr.Font.Color <> 0 Then Let Gdl2 = Gdl2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Gdl3 = Gdl3 + 1
                     ' Js As Long, Dpd As Long, Ppd As Long, Cab As Long, Bag As Long, Exe As Long
                     Case "JS"
                      Let Js = Js + 1: If rngStr.Font.Color <> 0 Then Let Js2 = Js2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Js3 = Js3 + 1
                     Case "DPD"
                      Let Dpd = Dpd + 1: If rngStr.Font.Color <> 0 Then Let Dpd2 = Dpd2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Dpd3 = Dpd3 + 1
                     Case "PPD"
                      Let Ppd = Ppd + 1: If rngStr.Font.Color <> 0 Then Let Ppd2 = Ppd2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Ppd3 = Ppd3 + 1
                     Case "CAB"
                      Let Cab = Cab + 1: If rngStr.Font.Color <> 0 Then Let Cab2 = Cab2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Cab3 = Cab3 + 1
                     Case "BAG"
                      Let Bag = Bag + 1: If rngStr.Font.Color <> 0 Then Let Bag2 = Bag2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Bag3 = Bag3 + 1
                     Case "EXE"
                      Let Exe = Exe + 1: If rngStr.Font.Color <> 0 Then Let Exe2 = Exe2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Exe3 = Exe3 + 1
                     ' DPB
                     Case "DPB"
                      Let Dpb = Dpb + 1: If rngStr.Font.Color <> 0 Then Let Dpb2 = Dpb2 + 1: If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Dpd3 = Dpd3 + 1
                     
                                          
                     Case Else
                      Debug.Print "Case Else   " & rngStr.Value
                      Let Els = Els + 1:: If rngStr.Font.Color <> 0 Then Let Els2 = Els2 + 1
                    End Select
                Else ' not a file path
                End If
            End If
'        Next ClCnt
'    Next RwCnt
    Next rngStr
Rem 4 output

Debug.Print "sys   " & Sys & " (" & Sys2 & ") [" & Sys3 & "]"
Debug.Print "dll   " & Ddl & " (" & Ddl2 & ") [" & Ddl3 & "]"
Debug.Print "bin   " & Bin & " (" & Bin2 & ") [" & Bin3 & "]"
Debug.Print "cpa   " & Cpa & " (" & Cpa2 & ") [" & Cpa3 & "]"
Debug.Print "vp   " & Vp & " (" & Vp2 & ") [" & Vp3 & "]"
Debug.Print "els   " & Els & " (" & Els2 & ")"
' Inf As Long, Ini As Long, Cat As Long, Gpd As Long, Xml As Long, Gdl As Long
Debug.Print "inf   " & Inf & " (" & Inf2 & ") [" & Inf3 & "]"
Debug.Print "ini   " & Ini & " (" & Ini2 & ") [" & Ini3 & "]"
Debug.Print "cat   " & Cat & " (" & Cat2 & ") [" & Cat3 & "]"
Debug.Print "gpd   " & Gpd & " (" & Gpd2 & ") [" & Gpd3 & "]"
Debug.Print "xml   " & Xml & " (" & Xml2 & ") [" & Xml3 & "]"
Debug.Print "gdl   " & Gdl & " (" & Gdl2 & ") [" & Gdl3 & "]"
' Js As Long, Dpd As Long, Ppd As Long, Cab As Long, Bag As Long, Exe As Long
Debug.Print "js   " & Js & " (" & Js2 & ") [" & Js3 & "]"
Debug.Print "dpd   " & Dpd & " (" & Dpd2 & ") [" & Dpd3 & "]"
Debug.Print "cab   " & Cab & " (" & Cab2 & ") [" & Cab3 & "]"
Debug.Print "bag   " & Bag & " (" & Bag2 & ") [" & Bag3 & "]"
Debug.Print "ppd   " & Ppd & " (" & Ppd2 & ") [" & Ppd3 & "]"
Debug.Print "exe   " & Exe & " (" & Exe2 & ") [" & Exe3 & "]"
' DPB
Debug.Print "dpb   " & Dpb & " (" & Dpb2 & ") [" & Dpb3 & "]"

Debug.Print " Total " & Sys + Ddl + Bin + Cpa + Vp + Els + Inf + Ini + Cat + Gpd + Xml + Gdl + Js + Dpd + Cab + Bag + Ppd + Exe + Dpb & " (" & Sys2 + Ddl2 + Bin2 + Cpa2 + Vp2 + Els2 + Inf2 + Ini2 + Cat2 + Gpd2 + Xml2 + Gdl2 + Js2 + Dpd2 + Cab2 + Bag2 + Ppd2 + Exe2 + Dpb2 & ") [" & Sys3 + Ddl3 + Bin3 + Cpa3 + Vp3 + Els3 + Inf3 + Ini3 + Cat3 + Gpd3 + Xml3 + Gdl3 + Js3 + Dpd3 + Cab3 + Bag3 + Ppd3 + Exe3 + Dpb3 & "]"
End Sub

**DocAElstein** · 03-09-2020, 02:29 AM

In support of this post
http://www.excelfox.com/forum/showth...ge29#post12484

Code:

'  Macro to color text of matching files in two worksheets
Sub CompareDriverFilesCommandIndrivers()  '
Rem 0
    If ActiveSheet.Name <> "PowerShell" Then
     MsgBox prompt:="Oops": Exit Sub
    Else
    End If
Rem 1 Worksheets info
Dim Wsdr As Worksheet, WsCmd As Worksheet
 Set Wsdr = Worksheets("drivers"): Set WsCmd = Worksheets("PowerShell")

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
        If CelVl <> "" And InStr(4, CelVl, ".", vbBinaryCompare) > 1 Then  ' use some criteria to check we have a file and not a Folder name with a  .  in it
            If Len(CelVl) > (InStr(4, CelVl, ".", vbBinaryCompare) + 3) Then
            ' case a lot of characters after the  .  so we probably have a Folder name
            Else
            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("=drivers!D4:drivers!E180")    '
            Dim FndCel As Range
             Set FndCel = SrchRng.Find(what:=FileNmeSrchFor, After:=Application.Range("=drivers!D4"), 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
                 WsCmd.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
                 Wsdr.Activate: FndCel.Select
                 Application.Wait (Now + TimeValue("00:00:02"))
                 Let FndCel.Font.ColorIndex = ClrIdx
                Else ' No match was found - the thing in the cell in
                End If
            End If ' end of check that the string with a  .  in it was a file
        Else ' case no file string in cell
        End If
    Next SrchForCel
End Sub

**DocAElstein** · 03-10-2020, 02:46 PM

In support of this Post
http://www.excelfox.com/forum/showth...ge29#post12485

Code:

'  Macro to color text of matching files in two worksheets
Sub CompareDriverFilesCommandInDriverStore()  '
Rem 0
    If ActiveSheet.Name <> "PowerShell" Then
     MsgBox prompt:="Oops": Exit Sub
    Else
    End If
Rem 1 Worksheets info
Dim WsDS As Worksheet, WsCmd As Worksheet
 Set WsDS = Worksheets("DriverStore"): Set WsCmd = Worksheets("PowerShell")

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
        If CelVl <> "" And InStr(4, CelVl, ".", vbBinaryCompare) > 1 Then  ' use some criteria to check we have a file and not a Folder name with a  .  in it
            If Len(CelVl) > (InStr(4, CelVl, ".", vbBinaryCompare) + 3) Then
            ' case a lot of characters after the  .  so we probably have a Folder name
            Else
            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("=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
                 '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
                 WsCmd.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
                 WsDS.Activate: FndCel.Select
                 Application.Wait (Now + TimeValue("00:00:02"))
                 Let FndCel.Font.ColorIndex = ClrIdx
                Else ' No match was found - the thing in the cell in
                End If
            End If ' end of check that the string with a  .  in it was a file
        Else ' case no file string in cell
        End If
    Next SrchForCel
End Sub

**DocAElstein** · 03-12-2020, 12:33 AM

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

**DocAElstein** · 03-12-2020, 10:40 PM

In support of this post:
http://www.excelfox.com/forum/showth...ge36#post12628

Note a new modification... for the case of when a cell in Device Manger is coloured ( indicating a match to drivers ) but the case when no match is found in DriverStore. We then need to make the underline which we are using as an indication for a match to drivers

Code:

            Else ' No match was found - the thing in the cell in this worksheet is not in the other worksheet
                If SrchForCel.Font.Color <> 0 Then Let SrchForCel.Font.Underline = True 'we need an extra check for if the cell is already coluoured indicating a match in drivers
            End If

Code:

Sub CompareDriverFilesDeviceManagerInDriverStore2() '
Rem 0
    If ActiveSheet.Name <> "DeviceManagerProperties" Then
     MsgBox prompt:="Oops": Exit Sub
    Else
    End If
Rem 1 Worksheets info
Dim WsDMP As Worksheet, WsDrSt As Worksheet
 Set WsDMP = Worksheets("DeviceManagerProperties"): 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
        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
        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
                 WsDMP.Activate: SrchForCel.Select
                 Let SrchForCel.Font.Underline = True
                Else
                End If
            'Debug.Print FndCel.Value
              Do While Not FndCel Is Nothing ' Start Find next loop ======
              '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 ' 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
              Set FndCel = Application.Range("=DriverStore!D" & FndCel.Row + 1 & ":DriverStore!F4437").Find(what:=FileNmeSrchFor, After:=Application.Range("=DriverStore!F4437"), LookIn:=xlValues, LookAt:=xlPart, searchorder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)  '
              Loop  '  End Find next loop =================================
            Else ' No match was found - the thing in the cell in this worksheet is not in the other worksheet
                If SrchForCel.Font.Color <> 0 Then Let SrchForCel.Font.Underline = True 'we need an extra check for if the cell is already coluoured indicating a match in drivers
            End If
        Else ' case no file path string in cell
        End If
    Next SrchForCel
End Sub

**DocAElstein** · 03-13-2020, 10:17 PM

In support of this Post
http://www.excelfox.com/forum/showth...ge39#post12659

Code:

Sub FileTypesHereInDeviceManagerPropertiesUndDriverStoreUnddrivers2() '   http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page39#post12659                                http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page18#post12360
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = Me
Dim Rng As Range: Set Rng = Ws.Range("D2:F264")
'Dim arrFiles() As Variant: Let arrFiles() = Rng.Value2
Rem 2 File extension types
Dim Ddl As Long, Sys As Long, Bin As Long, Cpa As Long, Vp As Long, Els As Long
Dim Ddl2 As Long, Sys2 As Long, Bin2 As Long, Cpa2 As Long, Vp2 As Long, Els2 As Long
Dim Ddl3 As Long, Sys3 As Long, Bin3 As Long, Cpa3 As Long, Vp3 As Long, Els3 As Long
Rem 3 Looping
'Dim ClCnt As Long, RwCnt As Long
Dim rngStr As Range ' a single cell to use as a stear element in the For Next loop
    For Each rngStr In Rng
'    For RwCnt = 1 To UBound(arrFiles(), 1)
'        For ClCnt = 1 To UBound(arrFiles(), 2)
            'If arrFiles(RwCnt, ClCnt) = "" Then
            If rngStr.Value = "" Then
            ' Empty cell, so do nothing
            Else ' Time to look at cell value
                'If Left(arrFiles(RwCnt, ClCnt), 3) = "C:\" And InStr(4, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
                If Left(rngStr.Value, 3) = "C:\" And InStr(4, rngStr.Value, ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
                ' Get the extension
                Dim Xtn As String
                'Let Xtn = Mid(arrFiles(RwCnt, ClCnt), (InStr(4, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) + 1))
                 Let Xtn = Mid(rngStr.Value, (InStr(4, rngStr.Value, ".", vbBinaryCompare) + 1))
                    Select Case UCase(Xtn)
                     Case "SYS"
                      Let Sys = Sys + 1
                      If rngStr.Font.Italic = True Then Let Sys2 = Sys2 + 1
                      If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Sys3 = Sys3 + 1
                     Case "DLL"
                      Let Ddl = Ddl + 1
                      If rngStr.Font.Italic = True Then Let Ddl2 = Ddl2 + 1
                      If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Ddl3 = Ddl3 + 1
                     Case "BIN"
                      Let Bin = Bin + 1
                      If rngStr.Font.Italic = True Then Let Bin2 = Bin2 + 1
                      If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Bin3 = Bin3 + 1
                     Case "CPA"
                      Let Cpa = Cpa + 1
                      If rngStr.Font.Italic = True Then Let Cpa2 = Cpa2 + 1
                      If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Cpa3 = Cpa3 + 1
                     Case "VP"
                      Let Vp = Vp + 1
                      If rngStr.Font.Italic = True Then Let Vp2 = Vp2 + 1
                      If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Vp3 = Vp3 + 1
                     Case Else
                      Debug.Print "Case Else   " & rngStr.Value
                      Let Els = Els + 1
                      If rngStr.Font.Italic = True Then Let Els2 = Els2 + 1
                      If rngStr.Font.Underline = xlUnderlineStyleSingle Then Let Els3 = Els3 + 1
                    End Select
                Else ' not a file path
                End If
            End If
'        Next ClCnt
'    Next RwCnt
    Next rngStr
Rem 4 output

Debug.Print "sys     " & Sys & " (" & Sys2 & ")   [" & Sys3 & "]"
Debug.Print "dll     " & Ddl & " (" & Ddl2 & ")   [" & Ddl3 & "]"
Debug.Print "bin     " & Bin & " (" & Bin2 & ")   [" & Bin3 & "]"
Debug.Print "cpa     " & Cpa & " (" & Cpa2 & ")   [" & Cpa3 & "]"
Debug.Print "vp      " & Vp & " (" & Vp2 & ")    [" & Vp3 & "]"
Debug.Print "els     " & Els & " (" & Els2 & ")   [" & Els3 & "]"

Debug.Print "Totals " & Sys + Ddl + Bin + Cpa + Vp + Els & " (" & Sys2 + Ddl2 + Bin2 + Cpa2 + Vp2 + Els2 & ") [" & Sys3 + Ddl3 + Bin3 + Cpa3 + Vp3 + Els3 & "]"
End Sub

**DocAElstein** · 03-18-2020, 03:35 PM

In support of this Thread answer
http://www.eileenslounge.com/viewtop...=34247#p265646

Code:

Option Explicit
Sub DDAllEarlier_Marz172020()  '    http://www.eileenslounge.com/viewtopic.php?f=55&t=34247#p265646
Dim WsDDD As Worksheet: Set WsDDD = Worksheets("DDAllEarlier_Marz17")
Dim RngDD As Range, rngDB As Range  '     =ANZAHL2(B2:B550) 255         =ANZAHL2(D2:D550)    366
 Set RngDD = WsDDD.Range("B2:B550"): Set rngDB = WsDDD.Range("D2:D550")
' 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 RngDD '----------------------|
        If Rng <> "" Then
        Dim ClrIdx As Long: Randomize: Let ClrIdx = (Int(Rnd * 54)) + 3
        Dim FndRng As Range
         Set FndRng = rngDB.Find(what:=Rng.Value, After:=rngDB.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.Font.Color = 0 Then ' case "virgin black" text
                     FndRng.Select
                     Let FndRng.Font.ColorIndex = ClrIdx
                     Application.Wait (Now + TimeValue("00:00:01"))
                     
                     Rng.Select
                     Let Rng.Font.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 = WsDDD.Range("D" & FndRng.Row + 1 & ":D550").Find(what:=Rng.Value, After:=WsDDD.Range("D550"), 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 RngDD ---------------|
End Sub

**DocAElstein** · 03-19-2020, 05:54 PM

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

**DocAElstein** · 03-20-2020, 01:34 AM

In support of this Post
http://www.excelfox.com/forum/showth...ge40#post12670

Code:

Option Explicit
' Marz 2020
Private Sub FileTypesHere_And_MaybeAlsoInDeviceManager()
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = Me
Dim Rng As Range: Set Rng = Ws.Range("D4:E300") 'Set Rng = Ws.Range("F4:G300") ' Set Rng = Ws.Range("D4:E75")
'Dim arrFiles() As Variant: Let arrFiles() = Rng.Value2
Rem 2 File extension types
Dim Ddl As Long, Sys As Long, Bin As Long, Cpa As Long, Vp As Long, Els As Long
Dim Bag As Long, Xml As Long, Js As Long, Gdl As Long, Cab As Long, Ini As Long
Dim Cat As Long, Inf As Long, Pnf As Long, Gpd As Long, Exe As Long
Dim Ddl2 As Long, Sys2 As Long, Bin2 As Long, Cpa2 As Long, Vp2 As Long
Dim Bag2 As Long, Xml2 As Long, Js2 As Long, Gdl2 As Long, Cab2 As Long, Ini2 As Long
Dim Cat2 As Long, Inf2 As Long, Pnf2 As Long, Gpd2 As Long, Exe2 As Long
Dim Dpb As Long, Ppd As Long
Dim Dpb2 As Long, Ppd2 As Long
Rem 3 Looping
Dim ClCnt As Long, RwCnt As Long
Dim rngStr As Range
    For Each rngStr In Rng
'    For RwCnt = 1 To UBound(arrFiles(), 1)
'        For ClCnt = 1 To UBound(arrFiles(), 2)
            'If arrFiles(RwCnt, ClCnt) = "" Then
            If rngStr.Value = "" Then
            ' Empty cell, so do nothing
            Else ' Time to look at cell value
'                If Left(arrFiles(RwCnt, ClCnt), 3) = "C:\" And InStr(4, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
                'If InStr(2, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
                If InStr(2, rngStr.Value, ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
                ' Get the extension
                Dim Xtn As String
                 'Let Xtn = Mid(arrFiles(RwCnt, ClCnt), (InStr(2, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) + 1))
                 Let Xtn = Mid(rngStr.Value, (InStr(2, rngStr.Value, ".", vbBinaryCompare) + 1))
                    Select Case UCase(Xtn)
                     Case "SYS"
                      Let Sys = Sys + 1: If rngStr.Font.Color <> 0 Then Let Sys2 = Sys2 + 1
                     Case "DLL"
                      Let Ddl = Ddl + 1: If rngStr.Font.Color <> 0 Then Let Ddl2 = Ddl2 + 1
                     Case "BIN"
                      Let Bin = Bin + 1: If rngStr.Font.Color <> 0 Then Let Bin2 = Bin2 + 1
                     Case "CPA"
                      Let Cpa = Cpa + 1: If rngStr.Font.Color <> 0 Then Let Cpa2 = Cpa2 + 1
                     Case "VP"
                      Let Vp = Vp + 1: If rngStr.Font.Color <> 0 Then Let Vp2 = Vp2 + 1
                     'Dim Bag As Long, Xml As Long, Js As Long, Gdl As Long, Cab As Long, Ini As Long, Cat As Long
                     Case "BAG"
                      Let Bag = Bag + 1: If rngStr.Font.Color <> 0 Then Let Bag2 = Bag2 + 1
                     Case "XML"
                      Let Xml = Xml + 1: If rngStr.Font.Color <> 0 Then Let Xml2 = Xml2 + 1
                     Case "JS"
                      Let Js = Js + 1: If rngStr.Font.Color <> 0 Then Let Js2 = Js2 + 1
                     Case "GDL"
                      Let Gdl = Gdl + 1: If rngStr.Font.Color <> 0 Then Let Gdl2 = Gdl2 + 1
                     Case "CAB"
                      Let Cab = Cab + 1: If rngStr.Font.Color <> 0 Then Let Cab2 = Cab2 + 1
                     Case "INI"
                      Let Ini = Ini + 1: If rngStr.Font.Color <> 0 Then Let Ini2 = Ini2 + 1
                     Case "CAT"
                      Let Cat = Cat + 1: If rngStr.Font.Color <> 0 Then Let Cat2 = Cat2 + 1
                     ' Inf As Long, Pnf As Long, Gpd As Long, Exe as long
                     Case "INF"
                      Let Inf = Inf + 1: If rngStr.Font.Color <> 0 Then Let Inf2 = Inf2 + 1
                     Case "PNF"
                      Let Pnf = Pnf + 1: If rngStr.Font.Color <> 0 Then Let Pnf2 = Pnf2 + 1
                     Case "GPD"
                      Let Gpd = Gpd + 1: If rngStr.Font.Color <> 0 Then Let Gpd2 = Gpd2 + 1
                     Case "EXE"
                      Let Exe = Exe + 1: If rngStr.Font.Color <> 0 Then Let Exe2 = Exe2 + 1
                     ' Dim Dpb As Long, Ppd As Long
                     Case "DPB"
                      Let Dpb = Dpb + 1: If rngStr.Font.Color <> 0 Then Let Dpb2 = Dpb2 + 1
                     Case "PPD"
                      Let Ppd = Ppd + 1: If rngStr.Font.Color <> 0 Then Let Ppd2 = Ppd2 + 1
                     Case Else
                      Debug.Print "Case Else   " & rngStr.Value ' arrFiles(RwCnt, ClCnt)
                      Let Els = Els + 1
                    End Select
                Else ' not a file path, or rather not a  .  in
                Dim Fldr As Long: Let Fldr = Fldr + 1
                End If
            End If
'        Next ClCnt
'    Next RwCnt
    Next rngStr
Rem 4 output
Debug.Print "sys   " & Sys & " (" & Sys2 & ")"
Debug.Print "dll   " & Ddl & " (" & Ddl2 & ")"
Debug.Print "bin   " & Bin & " (" & Bin2 & ")"
Debug.Print "cpa   " & Cpa & " (" & Cpa2 & ")"
Debug.Print "vp   " & Vp & " (" & Vp2 & ")"
Debug.Print "els   " & Els
'Dim Bag As Long, Xml As Long, Js As Long, Gdl As Long, Cab As Long, Ini As Long, Cat As Long
Debug.Print "bag   " & Bag & " (" & Bag2 & ")"
Debug.Print "xml   " & Xml & " (" & Xml2 & ")"
Debug.Print "js   " & Js & " (" & Js2 & ")"
Debug.Print "gdl   " & Gdl & " (" & Gdl2 & ")"
Debug.Print "cab   " & Cab & " (" & Cab2 & ")"
Debug.Print "ini   " & Ini & " (" & Ini2 & ")"
Debug.Print "cat   " & Cat & " (" & Cat2 & ")"
' Inf As Long, Pnf As Long, Gpd As Long, Exe as long
Debug.Print "inf   " & Inf & " (" & Inf2 & ")"
Debug.Print "pnf   " & Pnf & " (" & Pnf2 & ")"
Debug.Print "gpd   " & Gpd & " (" & Gpd2 & ")"
Debug.Print "exe   " & Exe & " (" & Exe2 & ")"
' Dim Dpb As Long, Ppd As Long
Debug.Print "dpb   " & Dpb & " (" & Dpb2 & ")"
Debug.Print "ppd   " & Ppd & " (" & Ppd2 & ")"
Debug.Print "Total files is  " & Sys + Ddl + Bin + Cpa + Vp + Bag + Xml + Js + Gdl + Cab + Ini + Cat + Inf + Pnf + Gpd + Exe + Dpb + Ppd
Debug.Print "Things with no  .  are  " & Fldr
End Sub

**DocAElstein** · 03-21-2020, 02:17 AM

In support of this post
http://www.excelfox.com/forum/showth...ge40#post12671

Code:

Option Explicit  '  http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page40#post12671
Sub DDAllEarlier_Marz172020()  '    http://www.eileenslounge.com/viewtopic.php?f=55&t=34247#p265646
Dim WsDDD As Worksheet: Set WsDDD = Worksheets("DDAllComparison")
Dim RngDD1 As Range, RngDD2 As Range  '
 Set RngDD1 = WsDDD.Range("D4:E680"): Set RngDD2 = WsDDD.Range("F4:H680")
' 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 RngDD1 '----------------------| 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 = RngDD2.Find(what:=Rng.Value, After:=RngDD2.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 = WsDDD.Range("F" & FndRng.Row + 1 & ":H680").Find(what:=Rng.Value, After:=WsDDD.Range("H680"), 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 RngDD1 ---------------|
End Sub