Fastest method of getting the bounding box containing all value ranges

Question

I want to find the fastest method of getting the range object which contains all values in a worksheet, while only containing 1 area. Traditionally one might think this is what UsedRange does, however UsedRange often selects cells outside of the value range.

screenshot of selection in workbook

I believe there is no existing VBA range which will suffice to this criteria alone then so I set out to build my own. I tested 2 versions. The first exploits the SpecialCells() function:

Function ValueBoundingBox(sht As Worksheet) As Range
 'Get used range
 Dim ur As Range
 Set ur = sht.UsedRange
 'If used range is 1x1 then result is 1x1
 If ur.Rows.Count = 1 And ur.Columns.Count = 1 Then
 Set ValueBoundingBox = ur
 Exit Function
 End If
 'Find all non-empty cells
 Dim x As Range
 Set x = Application.Union( _
 ur.SpecialCells(xlCellTypeConstants), _
 ur.SpecialCells(xlCellTypeFormulas) _
 )
 'Loop over all areas
 Dim area As Range, colMin, colMax, rowMin, rowMax, colArea, colAreaMax, rowArea, rowAreaMax As Long
 'Set Initial (Large) values for colMin and rowMin
 rowMin = 1048576
 colMin = 16384
 'Loop over all areas selected by special cells.
 For Each area In x.Areas
 With area
 'Calculate min and max rows/cols of area
 colArea = .Column
 colAreaMax = .Column + .Columns.Count
 rowArea = .row
 rowAreaMax = .row + .Rows.Count
 'Calculate min/max of range based on these values
 If rowAreaMax > rowMax Then rowMax = rowAreaMax
 If rowArea < rowMin Then rowMin = rowArea
 If colAreaMax > colMax Then colMax = colAreaMax
 If colArea < colMin Then colMin = colArea
 End With
 Next
 'Return bounding box
 Set ValueBoundingBox = Range(sht.Cells(rowMin, colMin), sht.Cells(rowMax, colMax))
End Function

The next uses the array of values extracted from a range to determine the minimum and maximum rows:

Function ValueBoundingBox2(sht As Worksheet) As Range
 'Get used range
 Dim ur As Range
 Set ur = sht.UsedRange
 'If used range is 1x1 then result is 1x1
 If ur.Rows.Count = 1 And ur.Columns.Count = 1 Then
 Set ValueBoundingBox2 = ur
 Exit Function
 End If
 'Find via array
 'Get array of all values:
 Dim v As Variant
 v = ur.Value
 'Define required values
 Dim colMin, colMax, rowMin, rowMax, row, col As Long
 'Find min row:
 For row = LBound(v, 1) To UBound(v, 1)
 For col = LBound(v, 2) To UBound(v, 2)
 If Not IsEmpty(v(row, col)) Then
 rowMin = row
 GoTo NextNum
 End If
 Next
 Next
NextNum:
 'Find max row
 For row = UBound(v, 1) To LBound(v, 1) Step -1
 For col = LBound(v, 2) To UBound(v, 2)
 If Not IsEmpty(v(row, col)) Then
 rowMax = row
 GoTo NextNum2
 End If
 Next
 Next
NextNum2:
 'Find min col:
 For col = LBound(v, 2) To UBound(v, 2)
 For row = LBound(v, 1) To UBound(v, 1)
 If Not IsEmpty(v(row, col)) Then
 colMin = col
 GoTo NextNum3
 End If
 Next
 Next
NextNum3:
 'Find max col
 For col = UBound(v, 2) To LBound(v, 2) Step -1
 For row = LBound(v, 1) To UBound(v, 1)
 If Not IsEmpty(v(row, col)) Then
 colMax = col
 GoTo NextNum4
 End If
 Next
 Next
NextNum4:
 Set ValueBoundingBox2 = Range(sht.Cells(rowMin, colMin), sht.Cells(rowMax, colMax))
End Function

Testing the above functions for performance results in the following results:

| Proc name | Time taken |
|-------------------|------------|
| ValueBoundingBox | 52s |
| ValueBoundingBox2 | 1s |

Clearly the 2nd version I made is far superior than the version which exploits SpecialCells() however I was wondering whether anyone else had any other ideas to speed up the algorithm further?

• PeterT: Given the example data in your image, you're expecting the function to return a range including only A1:A2 (the first contiguous data range) or A1:D7 (the bounding box containing all available data)? Also, what dataset are you testing the code to get the shown execution times?
• PeterT: Additionally, your ValueBoundingBox function fails for me on the line Set x = Application.Union when using the dataset in your image.
• Sancarn: Hi @PeterT sorry about the confusion. Yes "the bounding box containing all available data" is what I wanted i.e. A1:D7. Also you are correct, I didn't actually test the first function on that dataset in the image. That's just an example I found online :P I guess the alternative would be checking whether the range has values before hand, however it doesn't matter massively given the fact it's super slow :)
• TinMan: @Sancam Good catch. My logic for my loops was just bad. STD_Performance is missing from your past bin. Can you add it or better yet provide download link fr the test workbook? I thought of a simpler solution but don't want to post it without a speed comparison.
• Sancarn: @TinMan Good spot. I though I had removed the dependency but apparrently not. Here you go: pastebin.com/zPWKkYtM

Answer 1

I've tested all of the responses. And these are the results

FUNCTION | Valid? | Performance |
-----------------------------------------|--------|-------------|
Module1.RealUsedRange_Sancarn1 | YES | 76906.5109 |
Module1.RealUsedRange_Sancarn2 | YES | 6570.8505 |
Module1.RealUsedRange_VBasic2008 | YES | 44600.0445 |
Module1.RealUsedRange_IAmNerd2000_1 | NO | 21472.0677 |
Module1.RealUsedRange_Sancarn3 | YES | 5371.9298 |
Module1.RealUsedRange_IAmNerd2000_2 | YES | 8423.5989 |
Module1.RealUsedRange_VBasic2008_refac | YES | 35906.7597 |
Module1.RealUsedRange_Tinman | NO | 6489.7732 |
Module1.ValueRange | YES | 4930.6771 |

I had to modify the code I originally posted as it didn't work in some conditions. All test cases are tested with the code below. I've tried to make it easy for you to set up your own test cases by providing a CreateTestRange function. You can test all functions by calling testAllFuncs. You can also add your own functions here also!:

https://pastebin.com/zPWKkYtM

The fastest method so far is listed as ValueRange and is a modification of which came from being inspired by code posted by IAmNerd2000.

In this post I'd like to cover the 2 best solutions discussed.

---

The simple solution

The simplest solution appears to be VBasic2008's version. This is solution is short and easy to understand. If code readability is more important to you than speed use this! Edit: I've refactored this code slightly which not only makes it faster but also makes it easier to understand:

Function RealUsedRange_VBasic2008_refac(sht As Worksheet) As Range
 Dim firstCell, lastCell1, lastCell2 As Range
 With sht
 'Start at first cell in sheet, go forward and find next cell (i.e. first cell of RealUsedRange)
 Set firstCell = .Cells.Find("*", .Cells(1, 1), Excel.XlFindLookIn.xlValues, , XlSearchOrder.xlByRows)
 If Not firstCell Is Nothing Then
 'Start at last cell in sheet, go back and find previous cell (i.e. last cell of RealUsedRange)
 Set lastCell1 = .Cells.Find("*", .Cells(1, 1), XlFindLookIn.xlValues, , XlSearchOrder.xlByColumns, xlPrevious)
 Set lastCell2 = .Cells.Find("*", .Cells(1, 1), XlFindLookIn.xlValues, , XlSearchOrder.xlByRows, xlPrevious)
 'Find combined range between first and last cell
 Set RealUsedRange_VBasic2008_refac = Range(firstCell, Range(lastCell1, lastCell2))
 End If
 End With
End Function

The optimal solution

If you are more concerned with performance than clean code use this. It restricts the number of calls to slow COM objects property accessors. This is the main reason why this solution is faster than the above simple method:

'Changes:
'V2 - Initial version using arrays by Sancarn.
'V3 - IAmNerd2000: Store ubound, lbound to prevent recalculation after compilation.
'V3 - MacroMark: Added fallback to VBasic2008's version for large ranges
'V4 - Tinman: Changed Dim a,b,c as x to Dim a as x, b as x, c as x
'V4 - Tinman: Changed use ur.countLarge instead of .rows.count and .columns.count for 1x1 check
'V4 - Tinman: Use Value2 instead of Value
Function ValueRange(sht As Worksheet) As Range
 'Get used range
 Dim ur As Range
 Set ur = sht.UsedRange
 'If used range is 1x1 then result is 1x1
 If ur.CountLarge = 1 Then
 Set ValueRange = ur
 Exit Function
 End If
 'Find via array
 'Get array of all values:
 On Error GoTo URValueError
 Dim v As Variant
 v = ur.Value2
 On Error GoTo 0
 'Offsets if they exist
 Dim offR As Long, offC As Long
 With ur
 offR = .row - 1
 offC = .Column - 1
 End With
 'Define required values
 Dim colMin As Long, colMax As Long, rowMin As Long, rowMax As Long, row As Long, col As Long
 'Find min row:
 Dim ubndR As Long, ubndC As Long, lbndR As Long, lbndC As Long
 lbndR = 1 'should always be 1
 lbndC = 1 'should always be 1
 ubndR = UBound(v, 1)
 ubndC = UBound(v, 2)
 For row = lbndR To ubndR
 For col = lbndC To ubndC
 If Not IsEmpty(v(row, col)) Then
 rowMin = row
 GoTo NextNum
 End If
 Next
 Next
NextNum:
 'Find max row
 For row = ubndR To lbndR Step -1
 For col = lbndC To ubndC
 If Not IsEmpty(v(row, col)) Then
 rowMax = row
 GoTo NextNum2
 End If
 Next
 Next
NextNum2:
 'Find min col:
 For col = lbndC To ubndC
 For row = lbndR To ubndR
 If Not IsEmpty(v(row, col)) Then
 colMin = col
 GoTo NextNum3
 End If
 Next
 Next
NextNum3:
 'Find max col
 For col = ubndC To lbndC Step -1
 For row = lbndR To ubndR
 If Not IsEmpty(v(row, col)) Then
 colMax = col
 GoTo NextNum4
 End If
 Next
 Next
NextNum4:
 Set ValueRange = Range(sht.Cells(offR + rowMin, offC + colMin), sht.Cells(offR + rowMax, offC + colMax))
 Exit Function
URValueError:
 If Err.Number = 7 Then 'Out of memory error:
 'If out of memory, fall back on VBasic2000's version. It's not optimal but it doesn't have memory issues!
 Dim firstCell As Range, lastCell1 As Range, lastCell2 As Range
 With sht
 Set firstCell = .Cells.Find("*", .Cells(1, 1), XlFindLookIn.xlFormulas, , XlSearchOrder.xlByRows)
 If Not firstCell Is Nothing Then
 Set lastCell1 = .Cells.Find("*", .Cells(1, 1), XlFindLookIn.xlFormulas, , XlSearchOrder.xlByColumns, xlPrevious)
 Set lastCell2 = .Cells.Find("*", .Cells(1, 1), XlFindLookIn.xlFormulas, , XlSearchOrder.xlByRows, xlPrevious)
 Set ValueRange = .Range(firstCell, Range(lastCell1, lastCell2))
 End If
 End With
 Else
 'Raise unhandled error
 Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
 End If
End Function

---

Edit: IAmNerd2000's original approach fails when formatting lies outside the "RealUsedRange". Thus it was removed from this post.

---

Edit: As MacroMarc pointed out, very large used ranges will cause the optimal code to crash due to an Out of memory error. As a current work around I resort to VBasic2008's code if the error occurs. So at worse it will be as slow as VBasic2008's code, but at best it will be 10x faster.

---

Edit: RealUsedRange_VBasic2008_refac didn't work in some situations. The solution has now been changed to reflect this.

---

Edit: Changes based on Tinman's post. Main changes were removing variant references, using CountLarge instead of .Rows.Count=1 and .Columns.Count=1 and Value2 instead of Value

• MacroMarc: This fails outright when clowns put some format (or even a value) in ZZ400000. This stuff happens with all sorts of jokers in the workforce, and is a real fail point. You will have to plan for breaking into chunks if you want to use arrays.
• Sancarn: @MacroMarc yes, everything pretty much fails at that point. But to be fair it depends what you mean by "fails". Or rather, it depends on what your use case is. In my case for example, it's detecting if a sheet is "valid" or tampered. In which case if some clown did add a cell into ZZ400000 then it would raise as tampered, which would be entirely correct.
• MacroMarc: I copied the code exactly and it failed as expected on line v = ur.Value. The code is not robust enough to deal with large UsedRanges.
• Sancarn: @MacroMarc right! Out of memory, I see. Will refactor to use VBasic2008's version if ur.value errors. I doubt it'd be easy to do anything else. Not totally sure how to get around the out of memory issue without introducing huge amounts of complications/slow downs.

Answer 2

In terms of speeding up your 2nd option. The following code changes should work. NOTICE that I put in a decrement counter in each loop. this should half the loops' run time.

You can then do this for each of your NextNum sections (NextNum, NextNum2, NextNum3, and NextNum4)

 Dim intK as integer
 Dim intUB1 as integer
 Dim intL as integer
 Dim intUB2 as integer
 'Find min row:
 intUB1 = UBOUND(v,1)
 intK = intUB1
 intUB2 = UBound(v,2)
 For row = LBound(v, 1) To intUB1
 intL = intUB2
 For col = LBound(v, 2) To intUB2
 If Not IsEmpty(v(row, col)) Then
 rowMin = row
 GoTo NextNum
 End If
 If Not IsEmpty(v(row, intL)) Then
 rowMin = row
 GoTo NextNum
 End If
 if intL <= row then Exit For
 intL = intL - 1
 Next
 For col = LBound(v, 2) To intUB2
 If Not IsEmpty(v(intK, col)) Then
 rowMin = intK
 GoTo NextNum
 End If
 If Not IsEmpty(v(intK, intL)) Then
 rowMin = intK
 GoTo NextNum
 End If
 if intL <= row then Exit For
 intL = intL - 1
 Next
 if intK <= row then exit for
 intK = intK - 1
 Next
 NextNum:

• Sancarn: That is quite ingenious! I will definitely test to see whether this is faster! Also, I forgot that storing UBound is faster than calculating it at the end of the loop arg. Thanks for the input!
• IAmNerd2000: You are welcome. Glad I could help.

Answer 3

This should work. It's pretty simple method. I cannot test with your sheet as mine is not nearly that large, but you can try it.

IMPORTANT NOTE: This MUST be called as a Sub if it is a function that is called from a cell then, it will not work. (because excel uses the active range to perform the start of the SpecialCells I believe).

I have tested this code with your picture of cells and it works well.

It also works with other versions of cell combinations and locations that I have tested.

The reason to use the following code is because it is simple and can save valuable programming time. The SpecialCells Method is reliable if used correctly just like any other programming language and function. It is worth a try and also worth timing with your larger data.

In addition, the OP also uses SpecialCells in his code, just not the same way that I have.

I hope this helps.

 Option Explicit
 Sub RunIT()
 'Input range must be the first cell of where the data starts
 GetAllCells Range("A1")
 End Sub
 Public Sub GetAllCells(rngInStartingRange As Range)
 Dim strTemp As String
 strTemp = Range(rngInStartingRange, rngInStartingRange.SpecialCells(xlLastCell, xlTextValues)).Address
 End Sub

• Sancarn: Thanks, I'll have a look to see whether using special cells in this way is any faster :)
• IAmNerd2000: after looking at @vbasic2008 's post I would use his. It is what you see is what you get as opposed to .specialcells (only Microsoft can see the logic)
• Sancarn: It is 5 times slower than this method and 100 times slower than the 2nd code I posted... xD I'm going to post the results today :) Also the "Important note" you mentioned isn't actually true from my testing... I'll post the test cases I used also :).
• Sancarn: Unfortunately this fails when cells are formatted external to the cells which contain values.

Answer 4

The Real Used Range (not UsedRange)

Using the Find Method

I've recently written this function:

'*******************************************************************************
' Purpose: Returns the used range of a worksheet.
' Returns: Range Object.
'*******************************************************************************
Function URng(Optional NotActiveSheet As Worksheet) As Range
 Dim objWs As Worksheet
 If Not NotActiveSheet Is Nothing Then
 Set objWs = NotActiveSheet
 Else: Set objWs = ActiveSheet: End If
 If Not objWs Is Nothing Then
 With objWs
 If Not .Cells.Find("*", .Cells(.Rows.count, .Columns.count), -4123, , 1) _
 Is Nothing Then Set URng = .Range(.Cells(.Cells.Find("*", _
 .Cells(.Rows.count, .Columns.count)).Row, .Cells.Find("*", _
 .Cells(.Rows.count, .Columns.count), , , 2).Column), .Cells(.Cells _
 .Find("*", , , , 1, 2).Row, .Cells.Find("*", , , , 2, 2).Column))
 End With
 Set objWs = Nothing
 End If
End Function
'*******************************************************************************
' Remarks: To remove any confusion about the search, consider a worksheet *
' containing only 3 rows and 3 columns. Then the search order *
' would be: *
' ------------------------------------------------------------------
' | Type | Start | Search Order |
' |----------------------------------------------------------------|
' | First Used Row | C3 | A1,B1,C1,A2,B2,C2,A3,B3,C3. |
' | First Used Column | C3 | A1,A2,A3,B1,B2,B3,C1,C2,C3. |
' | Last Used Row | A1 | C3,B3,A3,C2,B2,A2,C1,B1,A1. |
' | Last Used Column | A1 | C3,C2,C1,B3,B2,B1,A3,A2,A1. |
'*******************************************************************************

where you might find the following part to your interest:

With objWs
 If Not .Cells.Find("*", .Cells(.Rows.count, .Columns.count), -4123, , 1) _
 Is Nothing Then Set URng = .Range(.Cells(.Cells.Find("*", _
 .Cells(.Rows.count, .Columns.count)).Row, .Cells.Find("*", _
 .Cells(.Rows.count, .Columns.count), , , 2).Column), .Cells(.Cells _
 .Find("*", , , , 1, 2).Row, .Cells.Find("*", , , , 2, 2).Column))
End With

or in a Sub

Sub RealUsedRange()
 Const cSheet As Variant = "Sheet1" ' Worksheet Name/Index
 Dim URng As Range ' Real Used Range
 With ThisWorkbook.Worksheets(cSheet)
 If Not .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), -4123, , _
 1) Is Nothing Then Set URng = .Range(.Cells(.Cells.Find("*", _
 .Cells(.Rows.Count, .Columns.Count)).Row, .Cells.Find("*", _
 .Cells(.Rows.Count, .Columns.Count), , , 2).Column), _
 .Cells(.Cells.Find("*", , , , 1, 2).Row, .Cells _
 .Find("*", , , , 2, 2).Column))
 End With
 If Not URng Is Nothing Then
 Debug.Print "The Real Used Range address is [" & URng.Address & "]"
 Else
 MsgBox "Worksheet '" & cSheet & "' is empty."
 End If
End Sub

Other 'fractions' of the Real Used Range using the Find Method.

By the way, as the UsedRange property has failed you so will the SpecialCells method rather sooner than later since they are somehow connected. See example.

The Find Method's 6(9) Arguments

Microsoft (VBA Help)

Syntax: expression. Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)

Expression is a range object, in our case it will be .Cells which refers to all cells in the worksheet.

The Find method has 9 arguments:

1. What

2. After
3. LookIn
4. LookAt
5. SearchOrder
6. SearchDirection

7. MatchCase
8. MatchByte
9. SearchFormat

You can use them in Argument:Parameter style or enter them by adding their parameters in the exact order (separated by commas) which will be used here.

The What argument is understandable by itself: search for anything "*". The MatchCase argument is by default False (Caution: it is not by default False for the Replace method though). The arguments MatchByte and SearchFormat are beyond the scope of this case and will not be further investigated, which leaves us with arguments number 2 to 6.

2. After has to be a one-cell range contained in expression (Initial Search Range). Note that this cell will be searched last, so if you use .Cells(1, 1) or .Cells(1) the search will start with the next cell e.g. .Cells(1, 2), .Cells(2, 1)... or .Cells(2), or the previous cell e.g. .Cells(1,.Columns.Count), .Cells(.Rows.Count,1) or .Cells(.Cells.Count) depending on the SearchOrder and SearchDirection parameters. The default value is .Cells(1, 1) or .Cells(1), which can be omitted when used.

To calculate the Last Used Row, Last Used Column or Last Used Cell this parameter will be omitted (.Cells(1)) because we want to start searching from the last cell going up or to the left.
To calculate the First Used Row, First Used Column or First Used Cell this parameter will be .Cells(.Rows.Count, .Columns.Count) or .Cells(.Cells.Count) because we want to start searching from the first cell going down or to the right.

3. LookIn can be one of the following XLLookIn constants:
- xlValues or -4163 will find any cell with a value except a cell containing a formula that evaluates to "".
- xlFormulas or -4123 will find any cells with a value including cells containing a formula that evalutates to "". This parameter will be used because we cannot ignore cells containing a formula that evaluates to "".
- xlComments or -4144 will find any cell containing a comment (not used in this case).

4. LookAt can be one of the following XLLookAt constants:

• xlWhole or 1 searches for whole strings only i.e. to find a cell containing e.g. Word, it will find a cell containing Word, but will not find a cell containing WordId.

• xlPart or 2 searches for parts of the string i.e. to find a cell containing e.g. Word it will find cells containing both, Word or WordId.

From everything I've read it is unclear using which parameter would make our search faster so it will be omitted in our case. Should be further investigated.

5. SearchOrder can be one of the following XLSearchOrder constants:

• xlByRows or 1 will perform the search by rows e.g. in a Next search from the last cell it will search in A1, B1, C1...A2, B2, C2...(.Rows.Count, .Columns.Count).

• xlByColumns or 2 will perform the search by columns e.g. in a Next search from the last cell it will search in A1, A2, A3...B1, B2, B3...(.Rows.Count, .Columns.Count).

6. SearchDirection can be one of the following XLSearchDirection constants:

• xlNext or 1 (Default) in a 'by columns' search (xlByColumns) with After:="A5" will search in A6, A7, A8...

• xlPrevious or 2 in a 'by columns' search (xlByColumns) with After:="A5" will search in A4, A3, A2...

---

VBA Remarks

The settings for LookIn, LookAt, SearchOrder, and MatchByte are saved each time you use this method. If you don’t specify values for these arguments the next time you call the method, the saved values are used. Setting these arguments changes the settings in the Find dialog box, and changing the settings in the Find dialog box changes the saved values that are used if you omit the arguments. To avoid problems, set these arguments explicitly each time you use this method.

Note

There is the What argument, there are 2 arguments (After, SearchDirection) with possible default values and 3 arguments (LookIn, LookAt, SearchOrder) that are saved each time.

Dissecting the Real Used Range Expression

If Not .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), -4123, , _
 1) Is Nothing Then Set URng = .Range(.Cells(.Cells.Find("*", _
 .Cells(.Rows.Count, .Columns.Count)).Row, .Cells.Find("*", _
 .Cells(.Rows.Count, .Columns.Count), , , 2).Column), _
 .Cells(.Cells.Find("*", , , , 1, 2).Row, .Cells _
 .Find("*", , , , 2, 2).Column))

to be continued...

• Graham: Adding an explanation of the improvements in your code would improve your answer.
• PeterT: While I was able to run your code just fine, I have to admit it made my brain hurt to read. I found the commented-out portion of your linked answer on SO much clearer for what was going on.
• Sancarn: Wow. I tried for a long time to get the used range from Find("*") directly. Will add this to the test suite and report results tonight :)
• Sancarn: Unfortunately using find like this isn't the fastest, but it is the "simplest" (even if it does look very complicated lol!) Perhaps a slightly refactored version wouldn't lose too much speed yet still be fast but easier to understand :)
• Sancarn: Refactored and sped up in my answer :)