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.

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?

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

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:

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

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...