Appendix Thread. ( Codes for other Threads, ( Avinash ).)

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

Test blog post, and function needed for other posts…


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

Title….

I have sometimes needed to check for a specific file type in a list of files and folders. Often a simple search for the characters in the extension, ( for example .doc for a Word 2003 file )
I had a more difficult situation where with multiple file types and folders which included parts in the text string which could be mistakenly found in a search fir the extension part.

The logic behind the simple functions below is as follows.
A string is taken in, strIn.
The function contains a list of all extensions being searched for. If an extension is found in the supplied string, then that extension is the string returned by the function. ( The first character in the extension string will always be a . )
If no match is found then the string of
“0” & strIn ' note: that first character is a zero
is retuned

Notes:
In the list, the longest character length extension are at the beginning. This avoids a part of the longer character extension being mistaken as a shorter character extension, since the longest character length extensions will be detected firstly .

Code:

---

Sub TestieGetMyExtension()
 MsgBox prompt:=GetMyExtension("a")
 MsgBox prompt:=GetMyExtension("1394ohci.sys")
 MsgBox prompt:=GetMyExtension("61883.inf_amd64_fb51a2f8b89aa4a7")
 MsgBox prompt:=GetMyExtension("wiaky003.inf_loc")
 MsgBox prompt:=GetMyExtension("acpi.PNF")
 MsgBox prompt:=GetMyExtension("bcmwdidhdpcie.inf_amd64_977dcc915465b0e9")

End Sub
Public Function GetMyExtension(ByVal strIn As String) As String
Dim MyExts() As Variant
 Let MyExts() = Array("inf_loc", "sys.mui", "dll.mui", "sys", "dll", "bin", "cpa", "bag", "xml", "gdl", "cab", "ini", "cat", "inf", "pnf", "gpd", "exe", "sam", "hlp", "ntf", "ppd", "tbl", "icc", "dat", "dpb", "cty", "msc", "xst", "vp", "js")
Dim Stear As Variant
    For Each Stear In MyExts()
    Dim Lenf As Long: Let Lenf = Len(Stear)
        If Len(strIn) > Lenf + 1 Then ' Length of  strIn  must be at least 2 more characters longer than the extension from the array above ,  like  x.sys  so greater than the length of like the length of  .sys  which has the length of  (length of  sys )+1
        Dim LstBt As String
        Let LstBt = Right(strIn, Lenf)
            If "." & UCase(LstBt) = "." & UCase(Stear) Then
            Let GetMyExtension = Stear
            Exit Function ' end of function with sucessful file type find - give file type to  function return string value
            Else
            ' not this file type in last characters
            End If
        Else
        ' then input string is too short to include the current extension string in  Stear
        End If
    Next Stear
 Let GetMyExtension = "0" & strIn ' This allows a simple check for like  If Left(GetMyExstension(kjshdkjs,kiafh_.kjfh, 1)= 0 Then  to determine if we have a file type like we want
End Function


---

Code:

---

Sub CountMissingFilesFromOriginalInNewList2()
Dim WsDS As Worksheet: Set WsDS = Worksheets("DriverStoreCompareMarz17 2020") '    =ANZAHL2(H3:J4396)    =ANZAHL2(D3:F4396)
Dim RngDS1 As Range, RngDS2 As Range  '
 Set RngDS1 = WsDS.Range("G3:J4396"): Set RngDS2 = WsDS.Range("C3:F4396") ' A bit back to front 1 is right columns original , 2 is left columns new from Marz 2020

Dim Cnt1 As Long, cnt2 As Long, Rng As Range, strRej As String
    For Each Rng In RngDS1
        If Not Rng.Value = "" And Rng.Interior.ColorIndex = -4142 And Not Left(GetMyExtension(Rng.Value), 1) = "0" Then
        ' Not empty cell  And  No interior colour And  any file extension
        Let Cnt1 = Cnt1 + 1
        Else
            If Not Rng.Value = "" And Rng.Interior.ColorIndex = -4142 Then
            Let strRej = strRej & Rng.Value & vbCr & vbLf
            Let cnt2 = cnt2 + 1
            Else
            End If
        End If
    Next Rng
 MsgBox prompt:="Missing is  " & Cnt1 & vbCr & vbLf & vbCr & vbLf & "Not counted, not coloured: " & vbCr & vbLf & strRej & vbCr & vbLf & "Changed Folder names is  " & cnt2
 Debug.Print "Missing is  " & Cnt1 & vbCr & vbLf & vbCr & vbLf & "Not counted, not colured: " & vbCr & vbLf & strRej & vbCr & vbLf & "Changed Folder names is  " & cnt2
End Sub
Sub CountNewFilesFromInNewList2()
Dim WsDS As Worksheet: Set WsDS = Worksheets("DriverStoreCompareMarz17 2020") '    =ANZAHL2(H3:J4396)    =ANZAHL2(D3:F4396)
Dim RngDS1 As Range, RngDS2 As Range  '
 Set RngDS1 = WsDS.Range("G3:J4396"): Set RngDS2 = WsDS.Range("C3:F4396") ' A bit back to front 1 is right columns original , 2 is left columns new from Marz 2020

Dim Cnt1 As Long, cnt2 As Long, Rng As Range, strRej As String, strNew As String
    For Each Rng In RngDS2
        If Not Rng.Value = "" And Rng.Interior.ColorIndex = -4142 And Not Left(GetMyExtension(Rng.Value), 1) = "0" Then
        ' conditions to be met are  not empty  And  no interior colour  And  any file extension
        Let Cnt1 = Cnt1 + 1
        Let strNew = strNew & Rng.Value & vbCr & vbLf
        Else
            If Not Rng.Value = "" And Rng.Interior.ColorIndex = -4142 Then
            Let strRej = strRej & Rng.Value & vbCr & vbLf
            Let cnt2 = cnt2 + 1
            Else
            End If
        End If
    Next Rng
 MsgBox prompt:="New is  " & Cnt1 & vbCr & vbLf & "New are  " & strNew
 Debug.Print "New is  " & Cnt1 & vbCr & vbLf & "New are  " & strNew
' MsgBox prompt:="Missing is  " & Cnt1 & vbCr & vbLf & vbCr & vbLf & "Not counted, not coloured: " & vbCr & vbLf & strRej & vbCr & vbLf & "Changed Folder names is  " & cnt2
' Debug.Print "Missing is  " & Cnt1 & vbCr & vbLf & vbCr & vbLf & "Not counted, not colured: " & vbCr & vbLf & strRej & vbCr & vbLf & "Changed Folder names is  " & cnt2
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

In support of this post
http://www.excelfox.com/forum/showth...ge41#post12675
First use of Dictionary alternative.
The following two macros give similar results. The first is the big Case Else macro and the second the first use of a Dictionary, Dik, alternative.

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

Private Sub FilesTypeHereFromFunction()
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = Me
Dim rng2BSrchd As Range: Set rng2BSrchd = Ws.Range("D4:E260")
Rem 2 A Dik for the extensions and count thereof
'2a) Make the Dik
Dim Dik As Object: Set Dik = CreateObject("Scripting.Dictionary")
Dik.CompareMode = vbTextCompare ' make case insensitive, probably not necersary in our case as we do all comares at UCase to make it already case insensitive
'2b) Fill the Dik
Dim rngStr As Range
    For Each rngStr In rng2BSrchd
        If rngStr.Value = "" Then
        ' empty cell  Do nothing
        Else
        Dim FkBk As String
        Let FkBk = GetMeExtension(Trim(rngStr.Value))
            If Left(FkBk, 1) = "0" Then
            Dim Fldrs As String
            Let Fldrs = Fldrs & rngStr.Value & vbCr & vbLf
            Else ' we have an extension of a type we may or may not have had already
                If Dik.Exists("" & FkBk & "") Then
                Let Dik.Item("" & FkBk & "") = Dik.Item("" & FkBk & "") + 1 ' add to count of this extension, - the count is actually held as the item
                Else
                Dik.Add Key:="" & FkBk & "", Item:=1 ' I create an item who's key is the extension string, and make item the count of it,  1 here initially
                End If
            End If
        End If
   
    Next rngStr
'2c) output from Dik
Dim Kys() As Variant, Itms() As Variant
 Let Kys() = Dik.Keys(): Let Itms() = Dik.Items()
Dim Cnt As Long
    For Cnt = 0 To Dik.Count - 1 ' Note Dictionaries by default start at 0, but the count is the actual number, so  Count-1  is the last indicee and  0  is the first
    Debug.Print Kys()(Cnt) & " " & Itms()(Cnt)
    Next Cnt

End Sub

---

In support of this post
http://www.excelfox.com/forum/showth...ge41#post12675

Code:

---

'  http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page41#post12675
Sub NewCmdVNewDD()  '    http://www.eileenslounge.com/viewtopic.php?f=55&t=34247#p265646
Dim Wscmd As Worksheet: Set Wscmd = Worksheets("Command17Marz")
Dim Rngcmd As Range ' dont actually need this, since I make a selection.. but I can use it to check the selection
 Set Rngcmd = Wscmd.Range("D4:E260")
    If Intersect(Rngcmd, Selection) Is Nothing Then MsgBox prompt:="oops": Exit Sub
Dim WsDD As Worksheet: Set WsDD = Worksheets("DDAllComparison")
Dim RngDD As Range
 Set RngDD = WsDD.Range("E4:E680")
Dim ClrIdx As Long: Randomize: Let ClrIdx = (Int(Rnd * 54)) + 3
' take each cell in cmd range and find it in DD range
Dim Rng As Range
    For Each Rng In Selection
        If Rng <> "" Then
        Dim FndRng As Range ' range file cell found in DD
        Set FndRng = RngDD.Find(what:=Rng.Value, After:=RngDD.Cells.Item(1), LookAt:=xlPart, searchorder:=xlNext, MatchCase:=False) '
            If Not FndRng Is Nothing Then ' we have a match that may or may not be the only one in DD, I am assuming it is the only one in cmd, at least in the selection I am using
                Wscmd.Activate: Rng.Select
                Let Rng.Font.ColorIndex = ClrIdx
                Application.Wait (Now + TimeValue("00:00:01"))
                   
                    Do While Not FndRng Is Nothing
                    WsDD.Activate: FndRng.Select
                    Let FndRng.Font.ColorIndex = ClrIdx
                    Application.Wait (Now + TimeValue("00:00:01"))
                    Set FndRng = WsDD.Range("E" & FndRng.Row + 1 & ":E680").Find(what:=Rng.Value, After:=WsDD.Range("E680"), 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
                  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


---

Macro for this post solution, ( written by the son of God )
http://www.excelfox.com/forum/showth...ll=1#post12897

Code:

---

Sub conditionally_delete3() '  http://www.excelfox.com/forum/showthread.php/2436-conditionally-delete-entire-row?p=12893&viewfull=1#post12893
Rem 1 Worksheets info
Dim Wb1 As Workbook, Wb2 As Workbook, Ws1 As Worksheet, Ws2 As Worksheet
 Set Wb1 = Workbooks("STEP1U.xlsb") ' Workbooks("sample1.xlsx") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Upstox\STEP1U.xlsb")
 Set Ws1 = Wb1.Worksheets.Item(1) ' worksheet of first tab
 Set Wb2 = Workbooks("1.xls") ' Workbooks("sample2.xlsx") '  Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
 Set Ws2 = Wb2.Worksheets.Item(1) ' worksheet of first tab
'1b Ranges
Dim Rng1A As Range, Rng2B As Range
 Set Rng1A = Ws1.Range("A2:A" & Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row & "")
 Set Rng2B = Ws2.Range("B2:B" & Ws2.Range("B" & Ws2.Rows.Count & "").End(xlUp).Row & "")

Rem 2 Delete an entire row in Ws2 if value in column B is not anywhere in column A of Ws1
Dim Rws As Long
    For Rws = Ws2.Range("B" & Ws2.Rows.Count & "").End(xlUp).Row To 2 Step -1
    Dim rngFnd As Range
    Set rngFnd = Rng1A.Find(what:=Ws2.Range("B" & Rws & "").Value, After:=Rng1A.Item(1), 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
        If rngFnd Is Nothing Then ' The value from column B in Ws2 was not found in column A of Ws1
        Ws2.Range("B" & Rws & "").EntireRow.Delete Shift:=xlUp
        Else
        ' The value from column B in Ws2 was found in column A of Ws1 so do nothing
        End If
    Next Rws
   
'    Wb1.Save
'    Wb1.Close
'    Wb2.Save
'    Wb2.Close
End Sub

---

---

1.xls: https://app.box.com/s/th2xzmkh7rnfr4qf4dho1kpgudndm073

In support of these posts

http://www.excelfox.com/forum/showth...ge41#post12676
http://www.excelfox.com/forum/showth...ge41#post12677
http://www.excelfox.com/forum/showth...ge41#post12678

Code:

---

'  http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page41#post12676
Sub NewCmdVNewDD()  '    http://www.eileenslounge.com/viewtopic.php?f=55&t=34247#p265646
Dim Wscmd As Worksheet: Set Wscmd = Worksheets("Command17Marz")
Dim Rngcmd As Range ' dont actually need this, since I make a selection.. but I can use it to check the selection
 Set Rngcmd = Wscmd.Range("D4:E260")
    If Intersect(Rngcmd, Selection) Is Nothing Then MsgBox prompt:="oops": Exit Sub
Dim WsDD As Worksheet: Set WsDD = Worksheets("DDAllComparison")
Dim RngDD As Range
 Set RngDD = WsDD.Range("E4:E680")
Dim ClrIdx As Long: Randomize: Let ClrIdx = (Int(Rnd * 54)) + 3
' take each cell in cmd range and find it in DD range
Dim Rng As Range
    For Each Rng In Selection
        If Rng <> "" Then
        Dim FndRng As Range ' range file cell found in DD
        Set FndRng = RngDD.Find(what:=Rng.Value, After:=RngDD.Cells.Item(1), LookAt:=xlPart, searchorder:=xlNext, MatchCase:=False) '
            If Not FndRng Is Nothing Then ' we have a match that may or may not be the only one in DD, I am assuming it is the only one in cmd, at least in the selection I am using
                Wscmd.Activate: Rng.Select
                Let Rng.Font.ColorIndex = ClrIdx
                Application.Wait (Now + TimeValue("00:00:01"))
                   
                    Do While Not FndRng Is Nothing
                    WsDD.Activate: FndRng.Select
                    Let FndRng.Font.ColorIndex = ClrIdx
                    Application.Wait (Now + TimeValue("00:00:01"))
                    Set FndRng = WsDD.Range("E" & FndRng.Row + 1 & ":E680").Find(what:=Rng.Value, After:=WsDD.Range("E680"), 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
                  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

'  http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page41#post12677
Sub NewCmdVNewdrivers()  '    http://www.eileenslounge.com/viewtopic.php?f=55&t=34247#p265646
Dim Wscmd As Worksheet: Set Wscmd = Worksheets("Command17Marz")
Dim Rngcmd As Range ' dont actually need this, since I make a selection.. but I can use it to check the selection
 Set Rngcmd = Wscmd.Range("E4:F260")
    If Intersect(Rngcmd, Selection) Is Nothing Then MsgBox prompt:="oops": Exit Sub
Dim Wsdrs As Worksheet: Set Wsdrs = Worksheets("drivers marz 2020")
Dim Rngdrs As Range
 Set Rngdrs = Wsdrs.Range("D6:E180")
Dim ClrIdx As Long: Randomize: Let ClrIdx = (Int(Rnd * 54)) + 3
' take each cell in cmd range and find it in DD range
Dim Rng As Range
    For Each Rng In Selection
        If Rng <> "" Then
        Dim FndRng As Range ' range file cell found in DD
        Set FndRng = Rngdrs.Find(what:=Rng.Value, After:=Rngdrs.Cells.Item(1), LookAt:=xlPart, searchorder:=xlNext, MatchCase:=False) '
            If Not FndRng Is Nothing Then ' we have a match that may or may not be the only one in DD, I am assuming it is the only one in cmd, at least in the selection I am using
                Wscmd.Activate: Rng.Select
                Let Rng.Font.ColorIndex = ClrIdx
                Application.Wait (Now + TimeValue("00:00:01"))
                   
                    Do While Not FndRng Is Nothing
                    Wsdrs.Activate: FndRng.Select
                    Let FndRng.Font.ColorIndex = ClrIdx
                    Application.Wait (Now + TimeValue("00:00:01"))
                    Set FndRng = Wsdrs.Range("D" & FndRng.Row + 1 & ":E180").Find(what:=Rng.Value, After:=Wsdrs.Range("E180"), 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
                  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 ---- ---------------|
End Sub



'  http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page41#post12678
Sub NewCmdVNewDriverStore()  '    http://www.eileenslounge.com/viewtopic.php?f=55&t=34247#p265646
Dim Wscmd As Worksheet: Set Wscmd = Worksheets("Command17Marz")
Dim Rngcmd As Range ' dont actually need this, since I make a selection.. but I can use it to check the selection
 Set Rngcmd = Wscmd.Range("E4:F260")
    If Intersect(Rngcmd, Selection) Is Nothing Then MsgBox prompt:="oops": Exit Sub
Dim WsDS As Worksheet: Set WsDS = Worksheets("DriverStoreCompareMarz17 2020")
Dim RngDS As Range
 Set RngDS = WsDS.Range("D6:F4395")
Dim ClrIdx As Long: Randomize: Let ClrIdx = (Int(Rnd * 54)) + 3
' take each cell in cmd range and find it in DD range
Dim Rng As Range
    For Each Rng In Selection
        If Rng <> "" Then
        Dim FndRng As Range ' range file cell found in DD
        Set FndRng = RngDS.Find(what:=Rng.Value, After:=RngDS.Cells.Item(1), LookAt:=xlPart, searchorder:=xlNext, MatchCase:=False) '
            If Not FndRng Is Nothing Then ' we have a match that may or may not be the only one in DD, I am assuming it is the only one in cmd, at least in the selection I am using
                Wscmd.Activate: Rng.Select
                Let Rng.Font.ColorIndex = ClrIdx
                Application.Wait (Now + TimeValue("00:00:01"))
                   
                    Do While Not FndRng Is Nothing
                    WsDS.Activate: FndRng.Select
                    Let FndRng.Font.ColorIndex = ClrIdx
                    Application.Wait (Now + TimeValue("00:00:01"))
                    Set FndRng = WsDS.Range("D" & FndRng.Row + 1 & ":F4395").Find(what:=Rng.Value, After:=WsDS.Range("F4395"), 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
                  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


---