Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 658
  • Last Modified:

A macro to Count the number of rows across all worksheets

Hi All,
Need some help in coming up with a VBA. A summary worksheet which would print all the worksheet names and counts of all the used rows(After row 7) of the worksheets. I also want to exclude the worksheets like table of contents.

example:
WorkBook  with worksheets: Instructions, Table of contents, Abc1, Abc2, Abc3, Abc4, ............

Summary Worksheet would display:
Worksheet     Counts
Abc1                     20
Abc2                   100    
Abc3                   217
Abc4                   530
.
.
.

Total                   867

The below code has some limitations like excluding the desired worksheet and the rows after row number 7 needs to be taken into consideration.

Function Test_It()
    For Each Sheet In ThisWorkbook.Sheets
        Debug.Print Sheet.Name & vbTab & CountMyRows(Sheet.Name)
    Next Sheet
End Function


Function CountMyRows(SName) As Long         '# where SName is the name of a sheet
    Dim rowCount As Long
    rowCount = Worksheets(SName).UsedRange.Rows.Count
    CountMyRows = rowCount
End Function

Thanks in advance
0
Milind Agarwal
Asked:
Milind Agarwal
  • 2
1 Solution
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Please try this to see if this is what you are trying to achieve....

Sub CreateSummarySheet()
Dim sws As Worksheet, ws As Worksheet
Dim slr As Long
Dim Found As Boolean
Application.ScreenUpdating = False
On Error Resume Next
Set sws = Sheets("Summary")
sws.Cells.Clear
On Error GoTo 0
If sws Is Nothing Then
   Sheets.Add(Before:=Sheets(1)).Name = "Summary"
   Set sws = ActiveSheet
End If
With sws.Range("A1:B1")
   .Value = Array("Worksheet", "Count")
   .Font.Bold = True
   .Font.Size = 12
End With
For Each ws In Worksheets
   If ws.Name <> sws.Name And Not LCase(ws.Name) Like "table of content*" Then
      If ws.UsedRange.Rows.Count > 7 Then
         Found = True
         sws.Range("A" & Rows.Count).End(3)(2).Value = ws.Name
         sws.Range("B" & Rows.Count).End(3)(2).Value = ws.UsedRange.Rows.Count - 7
      End If
   End If
Next ws
If Found Then
   slr = sws.Cells(Rows.Count, 1).End(xlUp).Row
   With sws.Range("A" & slr + 1 & ":B" & slr + 1)
      .Value = Array("Total", Application.Sum(sws.Columns(2)))
      .Font.Bold = True
      .Font.Size = 12
   End With
   sws.Columns.AutoFit
   sws.Range("A1").CurrentRegion.Borders.Color = vbBlack
End If
Application.ScreenUpdating = True
End Sub

Open in new window

1
 
Milind AgarwalAuthor Commented:
Worked like a dream
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Milind! Glad to help.
1

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now