Appendix-Thread-Evaluate-Range-(-Codes-for-other-Threads-HTML-Tables-etc-)

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

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

---

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


---

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

---

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

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




---

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

---

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

Code:

---

'  http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page40#post12672
'  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
Private Sub FileTypesHereIndrivers_()
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = Worksheets("drivers marz 2020")
Dim Rng As Range: Set Rng = Ws.Range("C2:E180") ' Ws.Range("F2:H180") ' Ws.Range("C2:E180")
'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
Dim Bag As Long, Xml As Long, Js As Long, Gdl As Long, Cab As Long, Ini As Long
Dim Bag2 As Long, Xml2 As Long, Js2 As Long, Gdl2 As Long, Cab2 As Long, Ini2 As Long
Dim Cat As Long, Inf As Long, Pnf As Long, Gpd As Long, Exe As Long
Dim Cat2 As Long, Inf2 As Long, Pnf2 As Long, Gpd2 As Long, Exe2 As Long
Dim Sam As Long
Dim Sam2 As Long
Rem 3 Looping
'Dim ClCnt As Long, RwCnt As Long
'    For RwCnt = 1 To UBound(arrFiles(), 1)
'        For ClCnt = 1 To UBound(arrFiles(), 2)
 Dim rngStr As Range
      For Each rngStr In Rng
            '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
'                    Dim Xtn As String: Let Xtn = Mid(arrFiles(RwCnt, ClCnt), (InStr(2, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) + 1)) ' this will give the text starting from after the first  dot  .
                If InStr(2, rngStr.Value, ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
                    Dim Xtn As String: Let Xtn = Mid(rngStr.Value, (InStr(2, rngStr.Value, ".", vbBinaryCompare) + 1)) ' this will give the text starting from after the first  dot  .
                    ' this next section catches single  .  things
'                    If Len(arrFiles(RwCnt, ClCnt)) - Len(Replace(arrFiles(RwCnt, ClCnt), ".", "")) = 1 Then ' case a single  .
                    If Len(rngStr.Value) - Len(Replace(rngStr.Value, ".", "")) = 1 Then ' case a single  .
                        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 = Bag + 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
                        ' sam
                        Case "SAM"
                          Let Sam = Sam + 1: If rngStr.Font.Color <> 0 Then Let Sam2 = Sam2 + 1
                        Case Else
                          Debug.Print "Case Else for single ""  .  ""    " & rngStr.Value
                          Let Els = Els + 1
                        End Select
                    ElseIf Len(rngStr.Value) - Len(Replace(rngStr.Value, ".", "")) = 2 Then ' a thing like  hidscanner.dll.mui  or  sdstor.sys.mui
                    ' this next section catches double  .  .  things
                    Dim DllMui As Long, SysMui As Long, Els2 As Long
                    Dim DllMui2 As Long, SysMui2 As Long
                        Select Case UCase(Xtn)
                        Case "DLL.MUI"
                          Let DllMui = DllMui + 1: If rngStr.Font.Color <> 0 Then Let DllMui2 = DllMui + 1
                        Case "SYS.MUI"
                          Let SysMui = SysMui + 1: If rngStr.Font.Color <> 0 Then Let SysMui2 = SysMui + 1
                        Case Else
                          Debug.Print "Case Else for double ""  .    .  ""    " & rngStr.Value
                          Let Els2 = Els2 + 1
                        End Select
                    ElseIf Len(rngStr.Value) - Len(Replace(rngStr.Value, ".", "")) > 2 Then
                    ' this section catches strings with dots more than 2
                    Dim LtsDts As Long
                    Debug.Print "More than 2 dots  --  " & rngStr.Value
                    Let LtsDts = LtsDts + 1
                    End If
                Else ' not a file, ( well no  .  in it anyway )
                Dim Fldr As Long
                Debug.Print "Folder?    " & rngStr.Value
                Let Fldr = Fldr + 1
                End If
            End If
      Next rngStr
'        Next ClCnt
'    Next RwCnt
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 "Else1    " & 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 & ")"
' sam
Debug.Print "sam      " & Sam & " (" & Sam2 & ")"
' Dim DllMui As Long, SysMui As Long, Els2 As Long
Debug.Print "dll.mui  " & DllMui & " (" & DllMui2 & ")"
Debug.Print "sys.mui  " & SysMui & " (" & SysMui2 & ")"
Debug.Print "Else2    " & Els2
Debug.Print "Total files is  " & Els + Sys + Ddl + Bin + Cpa + Vp + Bag + Xml + Js + Gdl + Cab + Ini + Cat + Inf + Pnf + Gpd + Exe + Els2 + DllMui + SysMui + Sam & " (" & Sys2 + Ddl2 + Bin2 + Cpa2 + Vp2 + Bag2 + Xml2 + Js2 + Gdl2 + Cab2 + Ini2 + Cat2 + Inf2 + Pnf2 + Gpd2 + Exe2 + DllMui2 + SysMui2 + Sam2 & ")"
Debug.Print "Total Folders is    " & Fldr
Debug.Print "Total things with more than 2 dots is  " & LtsDts
End Sub


---

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

---

In support of this post…


http://www.excelfox.com/forum/showth...ge40#post12673

Code:

---

'  =ANZAHL2(H3:J4396)    =ANZAHL2(D3:F4396)  G3:J4396    C3:F4396
Private Sub FileTypesHereArraysNew()
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = Me
Dim Rng As Range: Set Rng = Ws.Range("A1:F4397")
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 Sam As Long
Dim Inf_loc As Long, Hlp As Long, Ntf As Long, Ppd As Long, Tbl As Long, Icc As Long, Dat As Long
Dim Dpb As Long, Cty As Long, Msc As Long, Xst As Long
Rem 3 Looping
Dim ClCnt As Long, RwCnt As Long
    For RwCnt = 1 To UBound(arrFiles(), 1)
        For ClCnt = 1 To UBound(arrFiles(), 2)
            If ClCnt = 2 And arrFiles(RwCnt, ClCnt) <> "" Then  ' case of folder path
                Dim Fldr As Long '  Debug.Print "Folder?    " & arrFiles(RwCnt, ClCnt)
                Let Fldr = Fldr + 1
                Let RwCnt = RwCnt + 1 ' this is naughty, but will stop us hitting the folder name as the columns increase
            Else ' not a folder and if empty then not in column 2
                If arrFiles(RwCnt, ClCnt) = "" 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
                        Dim Xtn As String: Let Xtn = Mid(arrFiles(RwCnt, ClCnt), (InStr(2, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) + 1)) ' this will give the text starting from after the first  dot  .
                        ' this next section catches single  .  things
                        If Len(arrFiles(RwCnt, ClCnt)) - Len(Replace(arrFiles(RwCnt, ClCnt), ".", "")) = 1 Then ' case a single  .
                            Select Case UCase(Xtn)
                            Case "SYS"
                              Let Sys = Sys + 1
                            Case "DLL"
                              Let Ddl = Ddl + 1
                            Case "BIN"
                              Let Bin = Bin + 1
                            Case "CPA"
                              Let Cpa = Cpa + 1
                            Case "VP"
                              Let Vp = Vp + 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
                            Case "XML"
                              Let Xml = Xml + 1
                            Case "JS"
                              Let Js = Js + 1
                            Case "GDL"
                              Let Gdl = Gdl + 1
                            Case "CAB"
                              Let Cab = Cab + 1
                            Case "INI"
                              Let Ini = Ini + 1
                            Case "CAT"
                              Let Cat = Cat + 1
                            ' Inf As Long, Pnf As Long, Gpd As Long, Exe as long
                            Case "INF"
                              Let Inf = Inf + 1
                            Case "PNF"
                              Let Pnf = Pnf + 1
                            Case "GPD"
                              Let Gpd = Gpd + 1
                            Case "EXE"
                              Let Exe = Exe + 1
                            ' sam
                            Case "SAM"
                              Let Sam = Sam + 1
                            'inf_loc Pnf HLP NTF Ppd TBL ICC DAT
                            Case "INF_LOC"
                              Let Inf_loc = Inf_loc + 1
                            Case "HLP"
                              Let Hlp = Hlp + 1
                            Case "NTF"
                              Let Ntf = Ntf + 1
                            Case "PPD"
                              Let Ppd = Ppd + 1
                            Case "TBL"
                              Let Tbl = Tbl + 1
                            Case "ICC"
                              Let Icc = Icc + 1
                            Case "DAT"
                              Let Dat = Dat + 1
                            'Dim Dpb As Long, Cty As Long, Msc As Long, Xst As Long
                            Case "DPB"
                              Let Dpb = Dpb + 1
                            Case "CTY"
                              Let Cty = Cty + 1
                            Case "MSC"
                              Let Msc = Msc + 1
                            Case "XST"
                              Let Xst = Xst + 1
                            Case Else
                              Debug.Print "Case Else for single ""  .  ""    " & arrFiles(RwCnt, ClCnt)
                              Let Els = Els + 1
                            End Select
                        ElseIf Len(arrFiles(RwCnt, ClCnt)) - Len(Replace(arrFiles(RwCnt, ClCnt), ".", "")) = 2 Then ' a thing like  hidscanner.dll.mui  or  sdstor.sys.mui
                        ' this next section catches double  .  .  things
                        Dim DllMui As Long, SysMui As Long, Els2 As Long
                            Select Case UCase(Xtn)
                            Case "DLL.MUI"
                              Let DllMui = DllMui + 1
                            Case "SYS.MUI"
                              Let SysMui = SysMui + 1
                            Case Else
                              Debug.Print "Case Else for double ""  .    .  ""    " & arrFiles(RwCnt, ClCnt)
                              Let Els2 = Els2 + 1
                            End Select
                        ElseIf Len(arrFiles(RwCnt, ClCnt)) - Len(Replace(arrFiles(RwCnt, ClCnt), ".", "")) > 2 Then
                        ' this section catches strings with dots more than 2
                        Dim LtsDts As Long
                        Debug.Print "More than 2 dots  --  " & arrFiles(RwCnt, ClCnt)
                        Let LtsDts = LtsDts + 1
                        End If
                    Else ' not a file, ( well no  .  in it anyway )
'                    Dim Fldr As Long
'                    Debug.Print "Folder?    " & arrFiles(RwCnt, ClCnt)
'                    Let Fldr = Fldr + 1
                    End If
                End If ' end of case empty cell
            End If ' end of folder is counted based on "G:\" in column B
        Next ClCnt
    Next RwCnt
Rem 4 output
Debug.Print "sys      " & Sys
Debug.Print "dll      " & Ddl
Debug.Print "bin      " & Bin
Debug.Print "cpa      " & Cpa
Debug.Print "vp      " & Vp
Debug.Print "Else1    " & 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
Debug.Print "xml      " & Xml
Debug.Print "js      " & Js
Debug.Print "gdl      " & Gdl
Debug.Print "cab      " & Cab
Debug.Print "ini      " & Ini
Debug.Print "cat      " & Cat
' Inf As Long, Pnf As Long, Gpd As Long, Exe as long
Debug.Print "inf      " & Inf
Debug.Print "pnf      " & Pnf
Debug.Print "gpd      " & Gpd
Debug.Print "exe      " & Exe
' sam
Debug.Print "sam      " & Sam
' inf_loc Pnf HLP NTF Ppd TBL ICC DAT
Debug.Print "inf_loc  " & Inf_loc
Debug.Print "pnf      " & Pnf
Debug.Print "hlp      " & Hlp
Debug.Print "ntf      " & Ntf
Debug.Print "ppd      " & Ppd
Debug.Print "tbl      " & Tbl
Debug.Print "icc      " & Tbl
Debug.Print "dat      " & Dat
' Dim Dpb As Long, Cty As Long, Msc As Long, Xst As Long
Debug.Print "dpb      " & Dpb
Debug.Print "cty      " & Cty
Debug.Print "msc      " & Msc
Debug.Print "xst      " & Xst
' Dim DllMui As Long, SysMui As Long, Els2 As Long
Debug.Print "dll.mui  " & DllMui
Debug.Print "sys.mui  " & SysMui
Debug.Print "Else2    " & Els2
Debug.Print "Total files is  " & Els + Sys + Ddl + Bin + Cpa + Vp + Bag + Xml + Js + Gdl + Cab + Ini + Cat + Inf + Pnf + Gpd + Exe + Els2 + DllMui + SysMui + Sam + Inf_loc + Hlp + Ntf + Ppd + Tbl + Icc + Dat + Dpb + Cty + Msc + Xst
Debug.Print "Total Folders is    " & Fldr
Debug.Print "Total things with more than 2 dots is  " & LtsDts
End Sub

---

ExplorerBefore DriverStore Comparison Marz 2020.xlsm : https://app.box.com/s/oy8pnuizk6xng1msqlsxho7l8e0bi0t8
Explorer Before DriverStore Comparison Marz 2020.xlsm : https://app.box.com/s/4zx7b8d2gwjix7u68zit6o22x7q0kwm2