# Visual Basic for Applications/Excel Sheet True Used Range

Jump to navigation
Jump to search

## Summary[edit]

- This code listing is for Excel. The procedure
*GetUsedRange*returns the true used range of the Worksheet in the function name. An example is also given below of its use in the procedure*WorkRangeInArray*. It can typically be used to find the next writing position on a worksheet, but in any case returns all of the cell limits on each run. - Reports on various internet sites describe problems with the built-in UsedRange function. The problem types, apart from errors of understanding, seem to be divided between issues concerning the number of cells scrolled and errors in reporting the used range itself. This author has been unable to reproduce errors in reporting the UsedRange but requests inputs from interested parties. Readers with a clear demonstration of the UsedRange problem might care to advise me of it in the
*Discussion*tab of this page. It is true to say that the removal of cell content at the end of a worksheet will not result in a revised scrolled region, and the use of*Ctrl-End*will still travel to the old position after deletion. These two matters are not necessarily linked however, since this still happens even while the UsedRange is correctly reported. In the meantime this code module will obtain a true used range. - The procedure
*GetUsedRange*approaches the used cells from the outer limits in all four directions, and then, after noting the first filled cells that it encounters for each direction, defines the overall range as the smallest bounding rectangle that fits the whole thing. It optionally returns the row and column bounds at the same time. - The procedure
*WorkRangeInArray*makes use of*GetUsedRange*in an example that loads a source sheet range onto an array for work, then passes it back to a target sheet, same or other, at some specified or default position.

## VBA Code Listing (Modified 3 Dec 2016)[edit]

Added descriptive variable names for *GetUsedRange* parameters in accordance with suggestion in *Discussion*.(3 Dec 2016)

```
Option Explicit
Sub TestGetUsedRange()
'assumes that there is a block of filled cells on worksheet 1
Dim rng As Range, t, wsS As Worksheet
Dim fr As Long, lr As Long, fc As Long, lc As Long
Set wsS = ThisWorkbook.Worksheets("Sheet1")
Set wsT = ThisWorkbook.Worksheets("Sheet2")
Set rng = GetUsedRange(wsS, fr, fc, lr, lc)
'count the row and cols in range
MsgBox (lr - fr + 1) & " Rows in the range"
MsgBox (lc - fc + 1) & " Columns in the range"
'get first row number and first col number in range
MsgBox fr & " is first row number in the range"
MsgBox fc & " is first col number in the range"
'get last row number and last col number in range
MsgBox lr & " is last row number in the range"
MsgBox lc & " is last col number in the range"
End Sub
Function GetUsedRange(ws As Worksheet, Optional FirstUsedRow As Long, Optional FirstUsedColumn As Long, _
Optional LastUsedRow As Long, Optional LastUsedColumn As Long) As Range
'gets an accurate used range
Dim s As String, X As Long
Dim rng As Range
Dim r1Fixed As Long, c1Fixed As Long
Dim r2Fixed As Long, c2Fixed As Long
Dim r1 As Long, c1 As Long
Dim r2 As Long, c2 As Long
Dim i As Long
Set GetUsedRange = Nothing
'Start with Excel's UsedRange function since
'any such Excel error results in wider limits
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
'early exit for single cell or none used
If r1 = r2 And c1 = c2 Then
Set GetUsedRange = ws.Cells(r1, c1)
FirstUsedRow = r1: LastUsedRow = r2: FirstUsedColumn = c1: LastUsedColumn = c2
Exit Function
Else
'continue to find used range
End If
'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
'empty row -- reduce
r1 = r1 + 1
Else
'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
'empty row -- reduce
c1 = c1 + 1
Else
'nonempty row, get out
Exit For
End If
Next
'reset the range
Set rng = ws.Range(ws.Cells(r1, c1), ws.Cells(r2, c2))
'start again
r1Fixed = r1
c1Fixed = c1
r2Fixed = r2
c2Fixed = c2
'do rows from bottom up
For i = r2Fixed - r1Fixed + 1 To 1 Step -1
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 output parameters
Set GetUsedRange = ws.Range(ws.Cells(r1, c1), ws.Cells(r2, c2))
FirstUsedRow = r1: LastUsedRow = r2: FirstUsedColumn = c1: LastUsedColumn = c2
End Function
Sub TestWorkRangeInArray()
'place a block of data in Sheet 1 before run
'transfers data via a work array to Sheet 2
Dim wsS As Worksheet, wsT As Worksheet
Set wsS = ThisWorkbook.Worksheets("Sheet1")
Set wsT = ThisWorkbook.Worksheets("Sheet2")
'used range of sheet 1 to sheet 2,
'to new top left start position r,c = 5,13
WorkRangeInArray wsS, wsT, 5, 13
Set wsS = Nothing
Set wsT = Nothing
End Sub
Function WorkRangeInArray(wsSrc As Worksheet, wsTarg As Worksheet, Optional PosR As Long, _
Optional PosC As Long) As Boolean
'loads target sheet range into a work array
'user should add array work to middle section, or not, if just for transfer
'writes work array onto target worksheet, or same if so specified
'optional target sheet position, defaults to same as source
Dim vArr As Variant, rngSrc As Range, rngTarg As Range
Dim fr As Long, fc As Long, lr As Long, lc As Long
Dim nRowsSrc As Long, nColsSrc As Long, nRowsTarg As Long, nColsTarg As Long
'Load target sheet range onto the work array
'gets true used range and its row/col number limits
Set rngSrc = GetUsedRange(wsSrc, fr, fc, lr, lc)
'load values into array
If rngSrc.Cells.Count = 1 Then
ReDim vArr(1 To 1, 1 To 1)
vArr(1, 1) = rngSrc.Value
Else
vArr = rngSrc
End If
'User can place array working here, if needed
'note that code below expects same array for output
'Write work array to position on the target sheet
'activate target sheet
wsTarg.Activate
'decide sheet positon for target data
If PosR > 0 And PosC > 0 Then 'use parameter position values
Set rngTarg = wsTarg.Cells(PosR, PosC)
Else
Set rngTarg = wsTarg.Cells(fr, fc) 'position same as source
End If
'extend target range to fit
Set rngTarg = rngTarg.Resize(UBound(vArr, 1), UBound(vArr, 2))
'transfer array data to target sheet
rngTarg = vArr
'Release object variables
Set rngSrc = Nothing
Set rngTarg = Nothing
Set wsSrc = Nothing
Set wsTarg = Nothing
'Transfers
WorkRangeInArray = True
End Function
```