EDIT: You can find the revised code under 'Corrected Code' below
I'm struggling to work out how to write a VBA function that will return an array, where each element of the array is a range object. Ideally, I would like to know how to write so that each range object can be a dis-contiguous selection of cells, in pseudo code, that would be something like:
MyReturnedArrayOfRangeObjects (1) = (A1:C3, A6, B4:B6)
I found this thread: Using an Array of Ranges in VBA - Excel This gets me a close, but I must be doing something wrong in my function declaration (I think).
A bunch of the original code was irrelevant to the question, so it's been removed and I've made a simple example that would return just a single cell in each array element. When I run this, the code below returns a ByRef type mismatch on the line:
Set FindLastContentCell(i) = LastCell
Apart from the code below, I have tried making the function declaration a variant (no change). If I remove 'Set' from the line of code shown above, I get a 'Function call on left-hand side of assignment must return Variant or Object':
Function FindLastContentCell(Optional WB As Workbook = Nothing, Optional JustWS As Worksheet = Nothing) As Range()
Dim myLastRow As Long, myLastCol As Long, i As Long
Dim wks As Worksheet
Dim dummyRng As Range, LastCell As Range
Dim AnyMerged As Variant
Dim Proceed As Boolean
Dim iResponse As Integer
' Initialise variables
Set LastCell = Nothing
i = 0
[Bunch of extra code removed]
If JustWS Is Nothing Then
If WB Is Nothing Then Set WB = ActiveWorkbook
For Each wks In WB.Worksheets
[Bunch of extra code removed]
If Proceed Then
With wks
myLastRow = 0
myLastCol = 0
Set dummyRng = .UsedRange
On Error Resume Next
myLastRow = .Cells.Find("*", after:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlWhole, _
searchdirection:=xlPrevious, SearchOrder:=xlByRows).row
myLastCol = .Cells.Find("*", after:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlWhole, _
searchdirection:=xlPrevious, SearchOrder:=xlByColumns).Column
End With
On Error GoTo 0
Set LastCell = Cells(myLastRow, myLastCol)
ReDim Preserve FindLastContentCell(0 To i)
Set FindLastContentCell(i) = LastCell
i = i + 1
End If
Next wks
End If
End Function
The calling sub is:
Sub temp()
Call FindLastContentCell
End Sub
Corrected Code
Sub Temp()
Dim rng As Range, results() As Range
Dim x As Variant
results() = FindLastContentCell
End Sub
Function FindLastContentCell(Optional WB As Workbook = Nothing, Optional JustWS As Worksheet = Nothing) As Variant
'Modded by me
'From:
' http://www.contextures.com/xlfaqApp.html#Unused
Dim myLastRow As Long, myLastCol As Long
Dim i As Integer
Dim wks As Worksheet
Dim dummyRng As Range, LastCell As Range, LastCells() As Range
Dim AnyMerged As Variant
Dim Proceed As Boolean
Dim iResponse As Integer
' Initialise variables
Set LastCell = Nothing
i = 0
' If the code is only to consider one worksheet passed as JustWS
' then determine if something was passed as JustWS
If JustWS Is Nothing Then
' Nothing is found in JustWS, so code runs for each worksheet, either in the passed workbook
' object, or else for the ActiveWorkbook
If WB Is Nothing Then Set WB = ActiveWorkbook
For Each wks In WB.Worksheets
' This is where the code will run from if something was passed as JustWS, otherwise the line below
' has no impact on code execution
RunOnce:
' Check for merged cells
AnyMerged = wks.UsedRange.MergeCells
' Responde accordingly and let user decide if neccessary
If AnyMerged = False Then
Proceed = True
ElseIf AnyMerged = True Then
MsgBox "The whole used range is merged. Nothing will be done on this worksheet"
Proceed = False
ElseIf IsNull(AnyMerged) Then
iResponse = MsgBox("There are some merged cells on the worksheet." & vbNewLine & _
"This might cause a problem with the calculation of the last cells location." & vbNewLine & vbNewLine & _
"Do you want to proceed anyway?", _
vbYesNo, _
"Calculate Last Cell")
If iResponse = vbYes Then
Proceed = True
Else
Proceed = False
End If
Else
MsgBox "If you this, an error has occured in FindLastContentCell." & vbNewLine & _
"Code execution has been stopped."
Stop
End If
If Proceed Then
With wks
myLastRow = 0
myLastCol = 0
Set dummyRng = .UsedRange
On Error Resume Next
myLastRow = .Cells.Find("*", after:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlWhole, _
searchdirection:=xlPrevious, SearchOrder:=xlByRows).row
myLastCol = .Cells.Find("*", after:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlWhole, _
searchdirection:=xlPrevious, SearchOrder:=xlByColumns).Column
End With
On Error GoTo 0
Set LastCell = Cells(myLastRow, myLastCol)
ReDim Preserve LastCells(i)
Set LastCells(i) = LastCell
i = i + 1
' * This is where code will exit if only a single worksheet is passed.
' * Exits if a worksheet object was passed as JustWS, rather than looping through each worksheet
' in the workbook variable that was either passed, or which defaults to ActiveWorkbook
If Not JustWS Is Nothing Then
FindLastContentCell = LastCells
Exit Function
End If
End If
Next wks
' If a worksheet was passed as JustWS
Else
GoTo RunJustOneWS
End If
FindLastContentCell = LastCells
' Exit upon completion of a workbook variable any code
' below here is only run if a worksheet is passed as JustWS
Exit Function
' Setup to run the single worksheet that was passed as JustWS
RunJustOneWS:
Set wks = JustWS
GoTo RunOnce
End Function
