Fastest method of getting the bounding box containing all value ranges 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 &gt; rowMax Then rowMax = rowAreaMax
      If rowArea &lt; rowMin Then rowMin = rowArea
      If colAreaMax &gt; colMax Then colMax = colAreaMax
      If colArea &lt; 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?
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