Count Non Blank Rows and Non Blank Cell In all Sheets of Workbook

If you want to count Non blank Rows and Cells of All Worksheet in A workbook . Snapshot Below-



Here is the code-


Dim i, k, j, w As Long
Dim swa As Workbook
Dim fldpath
Dim fld, fil, subfld As Object

Sub count_non_blank_rows_cells()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'********************* to get file names in folder
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choose Folder"
Application.FileDialog(msoFileDialogFolderPicker).Show
fldpath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
Set fso = CreateObject("scripting.filesystemobject")
Set fld = fso.getfolder(fldpath)
getnames fld

Application.ScreenUpdating = True

Application.DisplayAlerts = True
End Sub

Sub getnames(ByRef prntfld)
For Each fil In prntfld.Files
If UCase(Right(fil.Path, 4)) = UCase(".xls") Or UCase(Right(fil.Path, 5)) = UCase(".xlsx") Then
Set swa = Application.Workbooks.Open(fil.Path)
For w = 1 To swa.Sheets.Count
k = 0
For i = 1 To swa.Sheets(w).Range("a1").SpecialCells(xlLastCell).Row
If Application.WorksheetFunction.CountA(swa.Sheets(w).Rows(i & ":" & i)) > 0 Then
k = k + 1
End If
Next i
j = ThisWorkbook.Sheets(1).Range("A65356").End(xlUp).Row + 1
ThisWorkbook.Sheets(1).Cells(j, 1).Value = fil.Path
ThisWorkbook.Sheets(1).Cells(j, 2).Value = fil.Name
ThisWorkbook.Sheets(1).Cells(j, 3).Value = swa.Sheets(w).Name
ThisWorkbook.Sheets(1).Cells(j, 4).Value = k
ThisWorkbook.Sheets(1).Cells(j, 5).Value = Application.WorksheetFunction.CountA(swa.Sheets(w).UsedRange)
Next w
swa.Close
End If
Next fil


For Each subfld In prntfld.SubFolders
getnames subfld
Next subfld

End Sub


Excel Macro File http://www.filefactory.com/file/cdb4689/n/count_non_blank_rows.xlsm