As we mentioned in Chapter 18, the UsedRange method seems to have some problems, in that it does not always return what we would consider to be the currently used range, that is the smallest rectangular region of cells that contains all cells that currently have data. In any case, if you, too, have trouble with the UsedRange method, the following function can be used in its place. Note that the function GetUsedRange does assume that Excel's UsedRange method returns a superset of the correct used range.
The operation of GetUsedRange is straightforward. As its source code in Example 19-1 shows, the function starts with Excel's used range, determines the coordinates (row and column numbers) of the upper-left and lower-right corners of this range, and then proceeds to shrink this range if it contains rows or columns that are blank. This is determined by using the Excel CountA worksheet function, which counts the number of nonempty cells.
Example 19-1. The GetUsedRange Function
Function GetUsedRange(ws As Worksheet) As Range
' Assumes that Excel's UsedRange gives a superset ' of the real used range.
Dim s As String, x As Integer Dim rng As Range
Dim r1Fixed As Integer, c1Fixed As Integer Dim r2Fixed As Integer, c2Fixed As Integer Dim i As Integer
Dim r1 As Integer, c1 As Integer Dim r2 As Integer, c2 As Integer
Set GetUsedRange = Nothing
' Start with Excel's used range Set rng = ws.UsedRange
' Get bounding cells for Excel's used range ' That is, Cells(r1,c1) to Cells(r2,c2) r1 = rng.Row r2 = rng.Rows.Count + r1 - 1 c1 = rng.Column c2 = rng.Columns.Count + c1 - 1
' Save existing values r1Fixed = r1 c1Fixed = c1 r2Fixed = r2 c2Fixed = c2
' Check rows from top down for all blanks.
' If found, shrink rows.
If Application.CountA(rng.Rows(i)) = 0 Then
' nonempty row, get out Exit For End If Next
' Repeat for columns from left to right For i = 1 To c2Fixed - c1Fixed + 1
If Application.CountA(rng.Columns(i)) = 0 Then c1 = c1 + 1 Else
Exit For End If Next
' Start again r1Fixed = r1 c1Fixed = c1 r2Fixed = r2 c2Fixed = c2
' Do rows from bottom up
If Application.CountA(rng.Rows(i)) = 0 Then r2 = r2 - 1 Else
Exit For End If Next
' Repeat for columns from right to left For i = c2Fixed - c1Fixed + 1 To 1 Step -1
If Application.CountA(rng.Columns(i)) = 0 Then c2 = c2 - 1 Else
Exit For End If Next
Set GetUsedRange = _
ws.Range(ws.Cells(r1, c1), ws.Cells(r2, c2)) End Function
Was this article helpful?