Appendix Thread. 3 *

Some coding in support of this post
http://www.excelfox.com/forum/showth...age8#post12252
for worksheet "DDAllBefore"


( see also here : http://www.excelfox.com/forum/showth...ll=1#post12147
http://www.excelfox.com/forum/showth...ll=1#post12148 )

Code:

---

Option Explicit
Sub ColumnsE()
 Columns("E:E").SpecialCells(xlCellTypeConstants, xlTextValues + xlNumbers).Copy
 Paste Destination:=Range("E680")
End Sub


Sub FileTypesHere()
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 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 Dpb As Long
Dim Dpb2 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
                    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
                    ' 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
                    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
                    Case "GPD"
                      Let Gpd = Gpd + 1: If RngStr.Font.Color <> 0 Then Let Gpd2 = Gpd2 + 1
                    Case "XML"
                      Let Xml = Xml + 1: If RngStr.Font.Color <> 0 Then Let Xml2 = Xml2 + 1
                    Case "GDL"
                      Let Gdl = Gdl + 1: If RngStr.Font.Color <> 0 Then Let Gdl2 = Gdl2 + 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
                    Case "DPD"
                      Let Dpd = Dpd + 1: If RngStr.Font.Color <> 0 Then Let Dpd2 = Dpd2 + 1
                    Case "PPD"
                      Let Ppd = Ppd + 1: If RngStr.Font.Color <> 0 Then Let Ppd2 = Ppd2 + 1
                    Case "CAB"
                      Let Cab = Cab + 1: If RngStr.Font.Color <> 0 Then Let Cab2 = Cab2 + 1
                    Case "BAG"
                      Let Bag = Bag + 1: If RngStr.Font.Color <> 0 Then Let Bag2 = Bag2 + 1
                    Case "EXE"
                      Let Exe = Exe + 1: If RngStr.Font.Color <> 0 Then Let Exe2 = Exe2 + 1
                    ' DPB
                    Case "DPB"
                      Let Dpb = Dpb + 1: If RngStr.Font.Color <> 0 Then Let Dpb2 = Dpb2 + 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 & ")"
Debug.Print "dll  " & Ddl & " (" & Ddl2 & ")"
Debug.Print "bin  " & Bin & " (" & Bin2 & ")"
Debug.Print "cpa  " & Cpa & " (" & Cpa2 & ")"
Debug.Print "vp  " & Vp & " (" & Vp2 & ")"
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 & ")"
Debug.Print "ini  " & Ini & " (" & Ini2 & ")"
Debug.Print "cat  " & Cat & " (" & Cat2 & ")"
Debug.Print "gpd  " & Gpd & " (" & Gpd2 & ")"
Debug.Print "xml  " & Xml & " (" & Xml2 & ")"
Debug.Print "gdl  " & Gdl & " (" & Gdl2 & ")"
' Js As Long, Dpd As Long, Ppd As Long, Cab As Long, Bag As Long, Exe As Long
Debug.Print "js  " & Js & " (" & Js2 & ")"
Debug.Print "dpd  " & Dpd & " (" & Dpd2 & ")"
Debug.Print "cab  " & Cab & " (" & Cab2 & ")"
Debug.Print "bag  " & Bag & " (" & Bag2 & ")"
Debug.Print "ppd  " & Ppd & " (" & Ppd & ")"
Debug.Print "exe  " & Exe & " (" & Exe2 & ")"
' DPB
Debug.Print "dpb  " & Dpb & " (" & Dpb2 & ")"
End Sub

---

Some additional coding to help in this Post
http://www.excelfox.com/forum/showth...page9post12255

(VBA "arrays" version)

Code:

---

Option Explicit
Private Sub FileTypesHereArrays()
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = Me
Dim Rng As Range: 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, Cat As Long, Inf As Long, Pnf As Long, Gpd As Long, Exe 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 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
                ' Get the extension
                Dim Xtn As String
                Let Xtn = Mid(arrFiles(RwCnt, ClCnt), (InStr(2, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) + 1))
                    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
                    Case Else
                      Debug.Print "Case Else  " & arrFiles(RwCnt, ClCnt)
                      Let Els = Els + 1
                    End Select
                Else ' not a file path
                End If
            End If
        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 "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
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
Debug.Print "Total is  " & Sys + Ddl + Bin + Cpa + Vp + Bag + Xml + Js + Gdl + Cab + Ini + Cat + Inf + Pnf + Gpd + Exe
End Sub

---

In support of this post
http://www.excelfox.com/forum/showth...page9post12255

Code:

---

'
Sub CompareDriverFilesCommandInDeviceManager() '                        InDoubleDriverAllList()
Rem 0
    If ActiveSheet.Name <> "PowerShell" Then
    MsgBox prompt:="Oops": Exit Sub
    Else
    End If
Rem 1 Worksheets info
Dim WsDMP As Worksheet, WsCmd As Worksheet
 Set WsDMP = Worksheets("DeviceManagerProperties"): 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("=DeviceManagerProperties!D2:DeviceManagerProperties!F265")    '
            Dim FndCel As Range
            Set FndCel = SrchRng.Find(what:=FileNmeSrchFor, After:=Application.Range("=DeviceManagerProperties!D2"), 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
                WsDMP.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


---

Some additional coding to help in this Post
http://www.excelfox.com/forum/showth...page9post12255

("spreadsheet interaction" version)

Code:

---

Private Sub FileTypesHereSpreadsheetInteraction()
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = Me
Dim Rng As Range: 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
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
                    Case Else
                      Debug.Print "Case Else  " & rngStr.Value ' arrFiles(RwCnt, ClCnt)
                      Let Els = Els + 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 & ")"
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 & ")"
Debug.Print "Total is  " & Sys + Ddl + Bin + Cpa + Vp + Bag + Xml + Js + Gdl + Cab + Ini + Cat + Inf + Pnf + Gpd + Exe
End Sub

---

In support of this Post

http://www.excelfox.com/forum/showth...age9#post12263


Macro to colour match file entries in the two worksheets,
PowerShell
and
DDAllBefore

Code:

---

Option Explicit
Sub CompareDriverFilesCommandInDoubleDriver()  '    DeviceManager() '                        InDoubleDriverAllList()
Rem 0
    If ActiveSheet.Name <> "PowerShell" Then
    MsgBox prompt:="Oops": Exit Sub
    Else
    End If
Rem 1 Worksheets info
Dim WsDD As Worksheet, WsCmd As Worksheet
 Set WsDD = Worksheets("DDAllBefore"): 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("=DDAllBefore!D5:DDAllBefore!G670")    '
            Dim FndCel As Range
            Set FndCel = SrchRng.Find(what:=FileNmeSrchFor, After:=Application.Range("=DDAllBefore!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
                WsDD.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


---

' In support of this excelfox post : http://www.excelfox.com/forum/showth...ge10#post12271
' File to list all file types , and (those also appearing in DoubleDriver worksheet, ( Worksheets "DDAllBefore" ) )

Code:

---

' In support of this excelfox post : http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page10#post12271
' File to list all file types , and (those also appearing in DoubleDriver worksheet, ( Worksheets "DDAllBefore" ) )
Private Sub FileTypesHereAndAlsoInDoubleDriver()
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = Worksheets("PowerShell") ' Me
Dim Rng As Range: 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
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
                    Case Else
                      Debug.Print "Case Else  " & rngStr.Value ' arrFiles(RwCnt, ClCnt)
                      Let Els = Els + 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 & ")"
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 & ")"
Debug.Print "Total is  " & Sys + Ddl + Bin + Cpa + Vp + Bag + Xml + Js + Gdl + Cab + Ini + Cat + Inf + Pnf + Gpd + Exe
End Sub




---

In support of this post
http://www.excelfox.com/forum/showth...ge11#post12276

Code:

---

Option Explicit
Private Sub FileTypesHereArrays()
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = Me
Dim Rng As Range: Set Rng = Ws.Range("D4: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 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
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 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
                        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
        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
' 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
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...ge14#post12319

Code:

---

Sub FileTypesHereInDeviceManagerProperties()
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
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.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
                    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 & ")"
Debug.Print "dll  " & Ddl & " (" & Ddl2 & ")"
Debug.Print "bin  " & Bin & " (" & Bin2 & ")"
Debug.Print "cpa  " & Cpa & " (" & Cpa2 & ")"
Debug.Print "vp  " & Vp & " (" & Vp2 & ")"
Debug.Print "els  " & Els & " (" & Els2 & ")"

End Sub


---

In support of this post
http://www.excelfox.com/forum/showth...ge14#post12323

Code:

---

'====================================
' Dec 2017 For Python Comparison.                                                                                                    Tutorial Post: excelforum:  https://www.excelforum.com/tips-and-tutorials/1213798-all-sub-folder-and-file-list-from-vba-recursion-routine-explanation-and-method-comparison.html      Tutorial Post: ExcelFox:  http://www.excelfox.com/forum/showthread.php/1324-Loop-Through-Files-In-A-Folder-Using-VBA?p=10420#post10420
'http://excelpoweruser.blogspot.de/2012/04/looping-through-folders-and-files-in.html    http://www.excelforum.com/excel-programming-vba-macros/1126751-get-value-function-loop-through-all-files-in-folder-and-its-subfolders.html#post4316662    http://www.excelfox.com/forum/f5/loop-through-files-in-a-folder-using-vba-1324/
Sub VBADoStuffInFoldersInFolderRecursion() 'Main routine to "Call" the first copy of the second routine,  VBALoopThroughEachFolderAndItsFile(
Rem 1A) Some Worksheets and General Variables Info
Dim Ws As Worksheet          '_-Dim: Prepares "Pointer" to a "Blue Print" (or Form, Questionaire not yet filled in, a template etc.)"Pigeon Hole" in Memory, sufficient in construction to house a piece of Paper with code text giving the relevant information for the particular Variable Type. VBA is sent to it when it passes it. In a Routine it may be given a particular “Value”, or (“Values” for Objects).  There instructions say then how to do that and handle(store) that(those). At Dim the created Paper is like a Blue Print that has some empty spaces not yet filled in. A String is a a bit tricky. The Blue Print code line Paper in the Pigeon Hole will allow to note the string Length and an Initial start memory Location. This Location well have to change frequently as strings of different length are assigned. Instructiions will tell how to do this. Theoretically a specilal value vbNullString is set to aid in quich checks.. But..http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post4411
 Set Ws = ActiveSheet ' ThisWorkbook.Worksheets.Item(1) 'Worksheets("EFFldr") 'CHANGE TO SUIT YOUR WORKSHEET    '_- Set: Fill or partially Fill: Setting to a Class will involve the use of an extra New at this code line. I will then have an Object referred to as an instance of a Class. At this point I include information on my Pointer Pigeon hole for a distinct distinguishable usage of an Object of the Class. For the case of something such as a Workbook this instancing has already been done, and in addition some values are filled in specific memory locations which are also held as part of the information in the Pigeon Hole Pointer. We will have a different Pointer for each instance. In most excel versions we already have a few instances of Worksheets. Such instances Objects can be further used., - For this a Dim to the class will be necessary, but the New must be omitted at Set. I can assign as many variables that I wish to the same existing instance
 Ws.Range("B3:F30").ClearContents ' This line only needed for demo code
Dim celTL As Range: Set celTL = Ws.Range("B3") 'Top left of where Listing should go
Rem 2A) Get Folder Info
Dim strWB As String ' "Pointer" to a "Blue Print" (or Form, Questionaire not yet filled in, a template etc.)"Pigeon Hole" in Memory, sufficient in construction to house a piece of Paper with code text giving the relevant information for the particular Variable Type. VBA is sent to it when it passes it. In a Routine it may be given a particular “Value”, or (“Values” for Objects).  There instructions say then how to do that and handle(store) that(those). At Dim the created Paper is like a Blue Print that has some empty spaces not yet filled in. A String is a a bit tricky. The Blue Print code line Paper in the Pigeon Hole will allow to note the string Length and an Initial start memory Location. This Location well have to change frequently as strings of different length are assigned. Instructiions will tell how to do this. Theoretically a specilal value vbNullString is set to aid in quich checks.. But..http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post44116
 Let strWB = ThisWorkbook.Path & "\" & "DriverStore" ' "Double Driver Backup All" ' "Double Driver Backup Non Microsoft" ' "PowerShell driverbackup" ' "driverbackup" ' "Before" ' 'CHANGE TO SUIT if you store the main Folder to be looked through somewhere other than in the same Folder as this workbook in which the codes are in
Rem 3A ) ' FileSystemObject Object
Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject") 'Late Binding
'Dim FSO As Scripting.FileSystemObject 'Early Binding alternative  activate a reference to the Microsoft Scripting Runtime Library ( MSRL ) in the Tools References menu of VB Editor Options.
'Set FSO = New Scripting.FileSystemObject 'Create an Instance of the Class Scripting FileSystemObject
Dim myFolder As Object 'An Object from myFolder, can be an declared as Dim myFolder As Folder also for Early Binding
Set myFolder = FSO.GetFolder(strWB) 'Set the selected Folder to the Object Folder using this Method which takes as arbument the Full String Path
Rem 4A )
Dim rCnt As Long: Let rCnt = 1: Dim CopyNumber1 As Long: Let CopyNumber1 = 1 '"Run progressin ( "down vertical" ) axis ( Row count for output ), "Down Folder chain to the right", The Count of the Copy of the called Procedue, here set to 1 for the first called copy of the second routine, which is done from this Sub( )  . Any subsequent calls of further second routine copies will be made by the current copy as it "freezes" and sets of that next copy
celTL.Value = myFolder.Path: celTL.Offset(0, 1).Value = myFolder.Name: Ws.Columns("A:C").AutoFit 'First output Row
'( -- Rem 5A) )
Call LoopThroughEachFolderAndItsFile(myFolder, celTL, rCnt, CopyNumber1) 'Up until now we just got the initial Folder. Now we go to all sub folders  then all subfolders  then all subfolders.......
' let Application.ScreenUpdating = True ' If this had been set to False earlier towards the start, as is often done, then the code might run a bit quicker by virtue of not updating the worksheet everytime an entry is made, but it is not really nacerssary unless the number of Files and Folders is massive. Even then it is probably better not to do that so that in the case of an error one has an additional way in the worksheet to see where the code stopped / errored
MsgBox "All Excel Files processed", vbInformation
Ws.Columns("A:H").AutoFit
End Sub
'Rem 5A) --
Sub VBALoopThroughEachFolderAndItsFile(ByVal fldFldr As Object, ByRef celTL As Range, ByRef rCnt As Long, ByVal CopyNumberFroNxtLvl As Long)  'In below function we have a nested loop to iterate each files also
Dim myFldrs As Object ''This is used continuously as the "steering" thing, that is to say each Sub Folder in Folder loops, in loops, in loops......etc  ....can be Dim myFldrs As Folder for early bindingDim CopyNumber As Long 'equivalent to clmLvl in Rudis Q code
Dim CopyNumber As Long 'equivalent to clmLvl in Rudis Q code
 Let CopyNumber = CopyNumberFroNxtLvl 'This variable is local to the current running or paused copy of this routine.
    '5Ab) Doing stuff for current Folder
    For Each myFldrs In fldFldr.SubFolders 'SubFolders collection used to get at all Sub Folders
    ''''''''Doing stuff for each Folder, .. in this example giving '_-
            '_- its full path including name :                and just Flder Name                            ' -- *
    Let rCnt = rCnt + 1 + 1 ''At each folder we always move down a line, and a dd amm extra line  as a space between Folders ( The indication of the "column" or "down" to the right comes from the Copy Number of the Sub Procedure
    Let celTL.Cells(rCnt, 1).Value = myFldrs.Path: celTL.Cells(rCnt, CopyNumber).Offset(0, 2).Value = myFldrs.Name ' -- *                                            'Print out current Folder Path and Name in next free row.
    ''''''''End doing stuff for each Folder
    '5Ac) Doing stuff for current file.
    Dim oFile As Object '  ... for early binding can Dim oFile As file
            For Each oFile In myFldrs.Files 'Looking at all Files types initially '#####
            ''''''''Doing Stuff for Each File
    '            Dim Extension As String: Let Extension = Right(oFile.Name, (Len(oFile.Name) - (InStrRev(oFile.Name, ".")))) 'To get the bit just after the . dot.  #####
    '                If Left(Extension, 3) = "xls" Then 'Check for your required File Type    #####
                Let rCnt = rCnt + 1
                celTL.Cells(rCnt, CopyNumber).Offset(0, 2).Value = oFile.Name ' Do your stuff here
    '                Dim wkb As Workbook
                    On Error GoTo ErrHdlr 'In case problem opening file for example
    '                Set wkb = Workbooks.Open(oFile)
    '                wkb.Close SaveChanges:=True
    '                Else 'Do not do stuff for a Bad Extension                        ' #####
    '                End If '                                                        #####
            ''''''''End Doing Sttuff for Each File
NxtoFile:  Next oFile ' Spring Point after error handler so as to go on to next File after the File action that errored
    Call LoopThroughEachFolderAndItsFile(myFldrs, celTL, rCnt, CopyNumber + 1) 'This is an example of recursion. It is actually very simple once you understand it. But it is just incredibly difficult to put in words. It is basically a Procedure that keeps calling itself as much as necessary as it goes "along",  "down", or "to the right" of the Path "roots". Every time it goes off calling itself VBA runs a copy of that Procedure. It "Stacks" all info carefully for each "Copy" Run and continues to do this "drilling" down as far as it must, in this case finding the Next Folder, and then the next Folder in that, then the next Folder in that, then the next Folder in that...I think you get the point! Each time VBA makes a copy of the Routine and you go into that. The calling Routine then "freezes at its current state and all variable keep there values. The "Frozen" Routine then re starts when the copy finishes
    Next
Exit Sub 'Normal End for no Errors
Rem 6 ) Error handler section just put here for convenience
ErrHdlr: 'Hopefully we know why we are here, and after informing can continue ( to next file )
MsgBox prompt:="Error " & Err.Description & " with File " & oFile & ""
On Error GoTo -1 'This needs to be done to reset the VBA exceptional error state of being. Otherwise VBA "thinks" Errors are being handeled and will not respond again to the Error handler.
On Error GoTo 0 ' Swiches off the current error handler. I do not really need to do this. But it is good practice so the error handler is only in place at the point where i next am expecting an error
GoTo NxtoFile
End Sub


---

in support of this Thread post
http://www.excelfox.com/forum/showth...ge14#post12323

Code:

---

Option Explicit
Private Sub FileTypesHereArrays()
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = Me
Dim Rng As Range: Set Rng = Ws.Range("A1:F4437")
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


---