Summary Of Maximum Rows Used Across Each Sheet In A Workbook

**Excel Fox** · 09-03-2015, 01:09 PM

So this little routine basically gives a raw aka primitive indication of what are the maximum rows used across each sheet. Just wrote this for something I needed urgently, so the code would be quick and dirty. Due credit to shg for the letter converter

Code:

Sub SheetUsageByColumn()

    Dim wks As Worksheet
    Dim lngCount As Long
    Dim lngCol As Long
    Dim lngRow As Long
    Dim lngMaxRow As Long
    Dim lngMaxCol As Long
    Dim lngStartRow As Long
    Dim lngStartCol As Long
    Dim strMessage As String
    Dim lngTotalRows As Long: lngTotalRows = ActiveWorkbook.Sheets(1).Rows.Count
    
    For Each wks In ActiveWorkbook.Worksheets
        strMessage = strMessage & "For '" & wks.Name & "' tab with |<>|" & vbLf & vbLf
        lngStartRow = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row
        lngStartCol = 1
        For lngCol = 2 To wks.UsedRange.Columns.Count
            lngRow = wks.Cells(lngTotalRows, lngCol).End(xlUp).Row
            If lngRow <> lngStartRow Then
                lngMaxRow = Application.Max(lngMaxRow, lngRow, lngStartRow)
                strMessage = strMessage & ColLtr(lngStartCol) & "-" & ColLtr(lngCol - 1) & ":" & lngStartRow & vbTab
                lngStartRow = lngRow
                lngStartCol = lngCol
            End If
        Next lngCol
        lngMaxCol = lngCol - 1
        strMessage = Replace(strMessage, "|<>|", "upto " & lngMaxRow & " rows in " & lngMaxCol & " columns.")
        strMessage = strMessage & vbLf & vbLf
        lngMaxRow = Empty
    Next wks
    MsgBox strMessage
    
End Sub


Function ColLtr(ByVal iCol As Long) As String
    ' shg 2012
    If iCol Then ColLtr = ColLtr((iCol - 1) \ 26) & Chr(65 + (iCol - 1) Mod 26)
    
End Function

**Rick Rothstein** · 09-04-2015, 05:31 AM

I think there might be something wrong with your code. I notice that sometimes it ignores single values in the last column on a sheet. In addition to that, if you have a vertically merged cell at the bottom of the column, it reports the top row of the merged cells as the last used row whereas I think it should report the row number of the last cell in the merge. Also, for this on Sheet3...

C5: =IF(D1="","","X")

E2: 34

The MessageBox showed this for that sheet (ignored last colon and single formula)...

For 'Sheet3' tab with upto 5 rows in 3 columns.

A-B:1

As a side note, here is the function I would use for obtaining the column letter designation from its column number...

Code:

Function ColLtr(ByVal iCol As Long) As String
  ColLtr = Split(Cells(1, iCol).Address, "$")(1)
End Function

**Rick Rothstein** · 09-04-2015, 09:22 AM

Here is a macro that I have written to do what your original code does (this code seems to work correctly by accounting for formulas at the bottom of columns that display the empty string ("") and identifying the last cell in a vertical merge if that merge is at the bottom of the column). Note, though, that I changed the display slightly from what your code uses and I print nothing out for blank sheets.

Code:

Sub SheetUsageByWorksheets()
  Dim X As Long, MaxRow As Long, LastCol As Long
  Dim WS As Worksheet, AddrStr As String, MBxString As String, Addr() As String
  For Each WS In Worksheets
    MaxRow = 0
    LastCol = 0
    AddrStr = ""
    Erase Addr
    On Error Resume Next
    LastCol = WS.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    On Error GoTo 0
    If LastCol Then
      For X = 1 To LastCol
        With WS.Cells(Rows.Count, X).End(xlUp).Offset(1)
          .Cells = "#N/A"
          If .Row - 1 > MaxRow Then MaxRow = .Row - 1
        End With
      Next
      AddrStr = Intersect(WS.UsedRange, WS.Cells.SpecialCells(xlConstants, xlErrors)).Offset(-1).Address(, 0)
      WS.UsedRange.Replace "#N/A", "", xlWhole
      Addr = Split(AddrStr, ",")
      For X = 0 To UBound(Addr)
        If Addr(X) Like "*:*" Then Addr(X) = Left(Addr(X), InStrRev(Addr(X), "$", InStr(Addr(X), ":")) - 1) & Mid(Addr(X), InStr(Addr(X), ":"))
        Addr(X) = Replace(Addr(X), "$", "-")
      Next
      With WS.Cells(MaxRow + 1, "A").Resize(, UBound(Addr) + 1)
        .Cells = Addr
        .Sort .Cells, xlAscending, , , , , , xlNo, , , xlLeftToRight
        AddrStr = "For '" & WS.Name & "' tab with up to " & MaxRow & " rows in " & LastCol & " columns." & vbLf & vbLf & Join(Application.Index(.Value, 1, 0), "   ") & vbLf & vbLf
        .Clear
      End With
    End If
    MBxString = MBxString & AddrStr
  Next
  MsgBox MBxString
End Sub

**Excel Fox** · 09-04-2015, 12:56 PM

I filled entire column B with some value with all the other columns empty. It throwed a type mismatch error, and also modified Range("A2") of active sheet with A:B-1. When columns are entirely filled (which is a rare case anyway), we need to conditionally ensure that we get the last row number instead of the first. Similarly goes when the filled cells are discontiguous (like there a set of empty cells in between a single column that is filled till the very last row.

**Rick Rothstein** · 09-04-2015, 01:08 PM

Originally Posted by Excel Fox

I filled entire column B with some value with all the other columns empty.

Hmm, I never thought about that possibility (don't know why, I just didn't). Unfortunately, it is back to the drawing boards for me since a completely filled columns screws up two parts of the method I used.

**Rick Rothstein** · 09-04-2015, 02:59 PM

Originally Posted by Rick Rothstein

Unfortunately, it is back to the drawing boards for me...

Okay, I am back from the drawing board and I think the following code will work correctly in all scenarios discussed previously...

Code:

Sub SheetUsageByWorksheet()
  Dim Col As Long, X As Long, MaxRow As Long, LastRow As Long, PrevRow As Long, LastCol As Long
  Dim Addr As String, TextOut As String, Dashed() As String, Spaced() As String, WS As Worksheet
  On Error GoTo NoData
  For Each WS In Worksheets
    Addr = ""
    MaxRow = 0
    LastCol = WS.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    If LastCol Then
      For Col = 1 To LastCol
        LastRow = WS.Cells(Rows.Count, Col).End(xlUp).Offset(1).Row - 1
        If LastRow > MaxRow Then MaxRow = LastRow
        If Len(Cells(Rows.Count, Col).Formula) > 0 Then LastRow = Rows.Count
        Addr = Trim(Addr & " " & Split(Cells(1, Col).Address, "$")(1) & "-" & LastRow)
      Next
      Dashed = Split(Addr, "-")
      For X = 1 To UBound(Dashed) - 1
        If Val(Dashed(X)) = Val(Dashed(X + 1)) Then Dashed(X) = ":" & Mid(Dashed(X), InStr(Dashed(X), " ") + 1)
      Next
      Addr = Replace(Join(Dashed, "-"), "-:", ":")
      Spaced = Split(Addr)
      For X = 0 To UBound(Spaced)
        If Spaced(X) Like "*:*" Then Spaced(X) = Left(Spaced(X), InStr(Spaced(X), ":")) & Mid(Spaced(X), InStrRev(Spaced(X), ":") + 1)
      Next
      Addr = "For '" & WS.Name & "' tab with up to " & MaxRow & " rows in " & LastCol & " columns." & vbLf & vbLf & Replace(Join(Spaced), " ", "   ") & vbLf & vbLf
    End If
    TextOut = TextOut & Addr
Continue:
  Next
  MsgBox TextOut
  Exit Sub
NoData:
  Resume Continue
End Sub

**Excel Fox** · 09-04-2015, 12:18 PM

**Rick Rothstein** · 09-04-2015, 12:48 PM

Originally Posted by Excel Fox

no doubt who is the Guru in these parts... thank you Rick

**Admin** · 09-04-2015, 03:41 PM

@ Rick - like Addr, you also need to reset MaxRow variable as well.

**Rick Rothstein** · 09-04-2015, 07:35 PM

Originally Posted by Admin

@ Rick - like Addr, you also need to reset MaxRow variable as well.

I had finished writing the code and then posted it literally just before going to sleep for the "night" and I completely missed the row numbers weren't changing in the outputted MessageBox. Thanks for spotting the problem! I added the appropriate line of code in Message #8 so the code there now reads correctly.