Microsoft Office Tutorials and References
In Depth Information
19.5 Example: Getting the Used Range
.ShowError = True
.ErrorTitle = "Error:"
.ErrorMessage = "This is a error"
End With
19.5 Example: Getting the Used Range
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 s hows,
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.
For i = 1 To r2Fixed - r1Fixed + 1
If Application.CountA(rng.Rows(i)) = 0 Then
 
 
Search JabSto ::




Custom Search