Determining worksheet data area

CephasOz

New Member
CephasOz submitted a new Excel article:

Determining worksheet data area - Finding the last cell in a worksheet

There are a few standard ways to find the area containing data in a worksheet, but each has a problem.

1) Activesheet.Cells(1).CurrentRegion won't work correctly if there are blank rows or columns
2) Activesheet.Cells(Activesheet.Rows.Count, 1).End(xlUp).Row won't work correctly if there is data in a cell in a greater numbered row but in a different column.
3) Activesheet.UsedRegion isn't dynamic - it gets updated when Excel is good and ready
4) Using Find by either rows or columns only...

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a \$25,000 loan, 5% annual interest, 60 month loan.

pbornemeier

Well-known Member
In answering a recent post (Will blank cells in the table mess up my macro?), I ended up with this code to return the smallest rectangular range that holds all filled cells. I believe it supports the intent of the OP here.

Code:
``````Function ReturnFilledRectangularRegion(wks As Worksheet) As Range

Dim lLastRow As Long, lLastCol As Long
Dim lFirstRow As Long, lFirstCol As Long

With wks
lLastRow = .Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious, , , False).Row
lLastCol = .Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious, , , False).Column
lFirstRow = .Cells.Find("*", , xlFormulas, , xlByRows, xlNext, , , False).Row
lFirstCol = .Cells.Find("*", , xlFormulas, , xlByColumns, xlNext, , , False).Column
Set ReturnFilledRectangularRegion = .Range(.Cells(lFirstRow, lFirstCol), .Cells(lLastRow, lLastCol))
End With

End Function``````

Last edited by a moderator:

CephasOz

New Member
The code is concise, and we agree in using Find, but the code for ReturnFilledRectangularRegion has a few problems. It falls over on an empty worksheet, and also doesn't return the starting cell A1 as part of the range if the data is all on the first row, even when A1 isn't empty.

pbornemeier

Well-known Member
Thanks for pointing out the deficiencies. There can never be enough testing. The code below corrects the problems you noted as well as the similar problem when A1 is not empty and all filled cells are in the same column.

Code:
``````Function ReturnFilledRectangularRegion(wks As Worksheet) As Range
'If there is a populated region, return the range, else return Nothing

'Valid, although unexpected (by me) range formats will be returned if an entire
'  row or column is involved:
'Cell(s) Filled     Range Returned  Expected Range Format
'E5,I18             \$E\$5:\$I\$18      \$E\$5:\$I\$18
'XFD1               \$XFD\$1          \$XFD\$1
'A1, XFD3           \$1:\$3           \$A\$1:\$XFD\$3
'A1, XDFD1048576    \$1:\$1048576     \$A\$1:\$XDFD\$1048576
'A1, B1048576       \$A:\$B           \$A\$1:\$B\$1048576

Dim lLastRow As Long, lLastCol As Long
Dim lFirstRow As Long, lFirstCol As Long

With wks
On Error Resume Next  'Since these will fail (error 91) if worksheet empty
lLastRow = .Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious, , , False).row
lLastCol = .Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious, , , False).Column
lFirstRow = .Cells.Find("*", , xlFormulas, , xlByRows, xlNext, , , False).row
lFirstCol = .Cells.Find("*", , xlFormulas, , xlByColumns, xlNext, , , False).Column
If .Range("A1").Value <> vbNullString Then lFirstRow = 1: lFirstCol = 1
If Err.number <> 0 Then
Set ReturnFilledRectangularRegion = Nothing
Else
Set ReturnFilledRectangularRegion = .Range(.Cells(lFirstRow, lFirstCol), .Cells(lLastRow, lLastCol))
End If
On Error GoTo 0

End With

End Function

Sub Test_ReturnFilledRectangularRegion()

Dim rng As Range

Set rng = ReturnFilledRectangularRegion(ActiveSheet)

If rng Is Nothing Then
MsgBox "No filled Cells in " & ActiveSheet.Name
Else
MsgBox ActiveSheet.Name & " filled range is " & rng.Address
End If

End Sub``````