Summary Of Maximum Rows Used Across Each Sheet In A Workbook

**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