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
Reply With Quote
Bookmarks