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




Reply With Quote
Bookmarks