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

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