Specify an Excel range across sheets in VBA

Question

In VBA, why does the following fail?

Dim rng as Range rng = Range("Sheet1:Sheet3!A1")

It throws an HRESULT exception. Is there another way to construct this range in VBA? Note that you can enter a worksheet function like =SUM(Sheet1:Sheet3!A1) and it works fine.

Answer 1

Here's a set of UDF functions that accomplish essentially the same thing. The only caveat is that the reference to the 3D range is a string i.e. "Jan:Dec!A1" as opposed to straight up Jan:Dec!A1

'Adapted from https://web-beta.archive.org/web/20060313132405/http://www.j-walk.com/ss/excel/eee/eee003.txt by Andre Terra
Function CountIf3D(Range3D As String, Criteria As String, _
    Optional Count_Range As Variant) As Variant

    Dim sTestRange As String
    Dim sCountRange As String
    Dim Sheet1 As Integer
    Dim Sheet2 As Integer
    Dim n As Integer
    Dim Count As Double

    Application.Volatile

    If Parse3DRange(Application.Caller.Parent.Parent.Name, _
      Range3D, Sheet1, Sheet2, sTestRange) = False Then
      CountIf3D = CVErr(xlErrRef)
    End If

    If IsMissing(Count_Range) Then
      sCountRange = sTestRange
    Else
      sCountRange = Count_Range.Address
    End If

    Count = 0
    For n = Sheet1 To Sheet2
      With Worksheets(n)
        Count = Count + Application.WorksheetFunction.CountIf(.Range _
    (sTestRange), Criteria)
      End With
    Next n
    CountIf3D = Count
End Function  'CountIf3D

Function SumIf3D(Range3D As String, Criteria As String, _
    Optional Sum_Range As Variant) As Variant

    Dim sTestRange As String
    Dim sSumRange As String
    Dim Sheet1 As Integer
    Dim Sheet2 As Integer
    Dim n As Integer
    Dim Sum As Double

    Application.Volatile

    If Parse3DRange(Application.Caller.Parent.Parent.Name, _
      Range3D, Sheet1, Sheet2, sTestRange) = False Then
      SumIf3D = CVErr(xlErrRef)
    End If

    If IsMissing(Sum_Range) Then
      sSumRange = sTestRange
    Else
      sSumRange = Sum_Range.Address
    End If

    Sum = 0
    For n = Sheet1 To Sheet2
      With Worksheets(n)
        Sum = Sum + Application.WorksheetFunction.SumIf(.Range _
    (sTestRange), Criteria, .Range(sSumRange))
      End With
    Next n
    SumIf3D = Sum
End Function  'SumIf3D

Function AverageIf3D(Range3D As String, Criteria As String, _
    Optional Average_Range As Variant) As Variant

    Dim sTestRange As String
    Dim sSumRange As String
    Dim Sheet1 As Integer
    Dim Sheet2 As Integer
    Dim n As Integer
    Dim Sum As Double
    Dim Count As Double

    Application.Volatile

    If Parse3DRange(Application.Caller.Parent.Parent.Name, _
      Range3D, Sheet1, Sheet2, sTestRange) = False Then
      AverageIf3D = CVErr(xlErrRef)
    End If

    If IsMissing(Average_Range) Then
      sSumRange = sTestRange
    Else
      sSumRange = Average_Range.Address
    End If

    Sum = 0
    Count = 0
    For n = Sheet1 To Sheet2
      With Worksheets(n)
        Sum = Sum + Application.WorksheetFunction.SumIf(.Range(sTestRange), Criteria, .Range(sSumRange))
        Count = Count + Application.WorksheetFunction.CountIf(.Range(sTestRange), Criteria)
      End With
    Next n
    AverageIf3D = Sum / Count
End Function  'SumIf3D

Function Parse3DRange(sBook As String, SheetsAndRange _
    As String, FirstSheet As Integer, LastSheet As Integer, _
    sRange As String) As Boolean

    Dim sTemp As String
    Dim i As Integer
    Dim Sheet1 As String
    Dim Sheet2 As String

    Parse3DRange = False
    On Error GoTo Parse3DRangeError

    sTemp = SheetsAndRange
    i = InStr(sTemp, "!")
    If i = 0 Then Exit Function

    'next line will generate an error if range is invalid
    'if it's OK, it will be converted to absolute form
    sRange = Range(Mid$(sTemp, i + 1)).Address

    sTemp = Left$(sTemp, i - 1)
    i = InStr(sTemp, ":")
    Sheet2 = Trim(Mid$(sTemp, i + 1))
    If i > 0 Then
      Sheet1 = Trim(Left$(sTemp, i - 1))
    Else
      Sheet1 = Sheet2
    End If

    'next lines will generate errors if sheet names are invalid
    With Workbooks(sBook)
    FirstSheet = .Worksheets(Sheet1).Index
    LastSheet = .Worksheets(Sheet2).Index

    'swap if out of order
    If FirstSheet > LastSheet Then
      i = FirstSheet
      FirstSheet = LastSheet
      LastSheet = i
    End If

    i = .Worksheets.Count
    If FirstSheet >= 1 And LastSheet <= i Then
      Parse3DRange = True
    End If
    End With
Parse3DRangeError:
    On Error GoTo 0
    Exit Function

End Function  'Parse3DRange

Answer 2

A Range object is limited to only one worksheet. After all, it can have only a single parent.

The =SUM() function can operate on a group of ranges. (this is true for many worksheet functions)

EDIT#1

I have been searching for a solution since Janauary:

UDF Syntax

.

I have been using an array of ranges. Not a very good solution.

Answer 3

Untested, but try this

Dim rng as string
rng = "Sheet1:Sheet3!A1"
worksheet("Sheet1").range("B1").formula = "=SUM(" & rng & ")"

Answer 4

Just developing Gary's answer (if you're going to accept an answer, accept his :):

Using Range variable:

Sub SumTest1()

    Dim rSheet1     As Range
    Dim rSheet2     As Range
    Dim rSheet3     As Range
    Dim dSum        As Double

    With ThisWorkbook
        Set rSheet1 = .Sheets("Sheet1").Range("A1")
        Set rSheet2 = .Sheets("Sheet2").Range("A1")
        Set rSheet3 = .Sheets("Sheet3").Range("A1")
    End With

    dSum = WorksheetFunction.Sum(rSheet1, rSheet2, rSheet3)
    Debug.Print CStr(dSum)

End Sub

Using Variant variable:

Sub SumTest2()

    Dim vArray      As Variant
    Dim dSum        As Double

    With ThisWorkbook
        vArray = Array(.Sheets("Sheet1").Range("A1"), .Sheets("Sheet2").Range("A1"), .Sheets("Sheet3").Range("A1"))
    End With

    dSum = WorksheetFunction.Sum(vArray)
    Debug.Print CStr(dSum)

End Sub

Using no variable:

Sub SumTest3()

    Dim dSum        As Double

    With ThisWorkbook
        dSum = WorksheetFunction.Sum(Array(.Sheets("Sheet1").Range("A1"), .Sheets("Sheet2").Range("A1"), .Sheets("Sheet3").Range("A1")))
    End With

    Debug.Print CStr(dSum)

End Sub