VBA Change code from MSG Box to Summary Report - vba

Question

Good afternoon,
I have tried searching different forums to no avail.
I have the below VBA code that will loop through all files in a folder and generate in a msge box the total number of rows of every file looped in that folder.
What I need your help on if possible is generate a summary report.
Ideally
The summary report will show File name and show how many rows with data in column H.
Sub LoopThroughFiles()
Dim folderPath As String
folderPath = ThisWorkbook.Path & "\"
Filename = Dir(folderPath & "*.xlsx")
Do While Filename <> ""
Set wb = Workbooks.Open(folderPath & Filename, ReadOnly:=True)
For Each sh In wb.Sheets
If Application.CountA(sh.Range("H:H")) > 0 Then
myCount = myCount + sh.Range("H" & Rows.Count).End(xlUp).Row
End If
Next
wb.Close False
Filename = Dir
Set wb = Nothing
Loop
MsgBox myCount
End Sub

Answer 1

You could try opening a "home" workbook where all values are stored. Basically, what you'll need to do is open a new workbook, and during your loop through each of the files, you'll paste the file path and the row count in the new workbook. Hopefully this will help, or at least give you an idea of how to do what you're trying to do. `
Sub LoopThroughFiles()
Dim folderPath As String
Dim summarySheet as Workbook
set summarySheet = workbook.add
folderPath = ThisWorkbook.Path & "\"
Filename = Dir(folderPath & "*.xlsx")
Do While Filename <> ""
Set wb = Workbooks.Open(folderPath & Filename, ReadOnly:=True)
For Each sh In wb.Sheets
If Application.CountA(sh.Range("H:H")) > 0 Then
myCount = myCount + sh.Range("H" & Rows.Count).End(xlUp).Row
End If
Next
wb.Close False
summarySheet.activate
Range("A:A").insert Shift:=xlDown
Cells(1,1) = Filename
Cells(1,2) = myCount
Filename = Dir
Set wb = Nothing
Loop
MsgBox myCount
End Sub`