Pages

Tuesday, August 2, 2011

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

No comments:

Post a Comment