MS Excel / VBA help thread

(Paste this in a module. Change strSearchLoc for directory location andbooIncludeSubDirs to indicate if to search subdirs, and run test(). All kinds of quick and dirty...)

Option Explicit
Dim FileList() As String

Sub test()
Dim strSearchLoc As String, booIncludeSubDirs As Boolean
Dim fCount, DumpRange
Dim sh As Worksheet, cl As Range, strSheetString As String
Dim wbkOG As Workbook, wbkImport As Workbook

Dim booWasHidden As Boolean, intLastColumn As Long, intLastRow As Long, intLastNonBlankColumn As Long, intLastNonBlankRow As Long, shThisRun As Worksheet, intNextRow As Long

strSearchLoc = "C:\"

booIncludeSubDirs = False

Set wbkOG = ActiveWorkbook

Sheets.Add
Set shThisRun = ActiveSheet
Cells(1, 1) = "No"
Cells(1, 2).End(xlToLeft).Offset(0, 1) = "Dir"
Cells(1, 3) = "FNE"
Cells(1, 4) = "FileDateTime"
Cells(1, 5) = "FileSize"
Cells(1, 6) = "Sheet Name"
Cells(1, 7) = "Hidden?"
Cells(1, 8) = "Last Row in Memory"
Cells(1, 9) = "Last Column in Memory"
Cells(1, 10) = "Last NonBlank Row"
Cells(1, 11) = "Last NonBlank Column"
intNextRow = 1

BuildFileListArray strSearchLoc, "*.xl*", booIncludeSubDirs

For fCount = 1 To UBound(FileList)
    Workbooks.Open FileList(fCount), False, True
    Set wbkImport = ActiveWorkbook
    Application.DisplayAlerts = True
    For Each sh In Worksheets
        booWasHidden = False
        If sh.Visible = xlSheetHidden Then
            sh.Visible = xlSheetVisible
            booWasHidden = True
        End If
        intNextRow = intNextRow + 1
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 1) = intNextRow - 1
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 2) = WorksheetFunction.Substitute(FileList(fCount), Dir(FileList(fCount)), "")
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 3) = Dir(FileList(fCount))
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 4) = FileDateTime(FileList(fCount))
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 5) = FileLen(FileList(fCount))
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 6) = sh.Name
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 7) = booWasHidden
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 8) = sh.Cells.SpecialCells(xlCellTypeLastCell).Row
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 9) = sh.Cells.SpecialCells(xlCellTypeLastCell).Column
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 10) = GetLastRow(sh.Name)
        wbkOG.Sheets(shThisRun.Name).Cells(intNextRow, 11) = GetLastColumn(sh.Name)
    Next sh
    Workbooks(Dir(FileList(fCount))).Close (False)
Next fCount

End Sub
Public Function StripToAlphaC(strString As String) As String
Dim n As Integer, booRemove As Boolean

n = 0
StripToAlphaC = strString
For n = 1 To Len(StripToAlphaC)
    booRemove = True
    If Asc(Mid(StripToAlphaC, n, 1)) >= 48 And Asc(Mid(StripToAlphaC, n, 1)) <= 57 Then booRemove = False
    If Asc(Mid(StripToAlphaC, n, 1)) >= 65 And Asc(Mid(StripToAlphaC, n, 1)) <= 90 Then booRemove = False
    If Asc(Mid(StripToAlphaC, n, 1)) >= 97 And Asc(Mid(StripToAlphaC, n, 1)) <= 122 Then booRemove = False
    If Asc(Mid(StripToAlphaC, n, 1)) = 32 Then booRemove = False
    If booRemove Then
        StripToAlphaC = Left(StripToAlphaC, n - 1) & Right(StripToAlphaC, Len(StripToAlphaC) - n)
        n = n - 1

    End If
    If n >= Len(StripToAlphaC) Then Exit For

Next n
StripToAlphaC = StrConv(StripToAlphaC, vbProperCase)

End Function

Public Sub BuildFileListArray(PathToSearch As String, TextFilter As String, IncSubs As Boolean)
Dim sFName As String, fso As Object, strName As String, strArr(1 To 65536, 1 To 1) As String, I As Long, n As Integer

If IncSubs Then
    strName = Dir$(PathToSearch & "\*" & TextFilter & "*", 15)
    Do While strName <> vbNullString
        I = I + 1
        strArr(I, 1) = PathToSearch & "\" & strName
        strName = Dir$()
    Loop
    Set fso = CreateObject("Scripting.FileSystemObject")
    Call recurseSubFolders(fso.GetFolder(PathToSearch), strArr(), I, TextFilter)
    Set fso = Nothing
    If I > 0 Then
        ReDim Preserve FileList(I)
        For n = 1 To I
            FileList(n) = strArr(n, 1)
        Next n
    End If
Else
    sFName = Dir$(PathToSearch & "\*" & TextFilter & "*", 15)
    Do While Len(sFName) > 0
        n = n + 1
        ReDim Preserve FileList(n)
        FileList(n) = PathToSearch & "\" & sFName
        sFName = Dir$()
    Loop
End If

End Sub
Private Sub recurseSubFolders(ByRef Folder As Object, ByRef strArr() As String, ByRef I As Long, ByRef searchTerm As String)
Dim SubFolder As Object, strName As String

For Each SubFolder In Folder.SubFolders
    Let strName = Dir$(SubFolder.Path & "\*" & searchTerm & "*", 15)
    Do While strName <> vbNullString
        I = I + 1
        strArr(I, 1) = SubFolder.Path & "\" & strName
        strName = Dir$()
    Loop
    Call recurseSubFolders(SubFolder, strArr(), I, searchTerm)
Next

End Sub

Function GetLastRow(strSheetName) As Long
Dim x As Long

For x = 1 To Sheets(strSheetName).Cells.SpecialCells(xlCellTypeLastCell).Column
    If Sheets(strSheetName).Cells(1048576, x).End(xlUp).Row > GetLastRow Then GetLastRow = Sheets(strSheetName).Cells(1048576, x).End(xlUp).Row
    If GetLastRow = Sheets(strSheetName).Cells.SpecialCells(xlCellTypeLastCell).Row Then Exit Function
Next x

End Function
Function GetLastColumn(strSheetName) As Long
Dim x As Long

GetLastColumn = Sheets(strSheetName).Cells.SpecialCells(xlCellTypeLastCell).Column
Do
    If Sheets(strSheetName).Cells(1048576, GetLastColumn).End(xlUp).Row = 1 And Sheets(strSheetName).Cells(1, GetLastColumn) = "" Then
        GetLastColumn = GetLastColumn - 1
    Else
        Exit Do
    End If
Loop Until GetLastColumn <= 1

If GetLastColumn = 0 Then GetLastColumn = 1

End Function