Ouput function result of calculation to multiple Cells in Excel using VBA - excel

Question

Im using VBA to program a function in excel that will search a list looking for certain names, count when certain sought for names come up and then output these counter values to individual cells.
How do I allocate the values to the function itself when I have a multi cell function? Ive chosen 4 cells next to each other in the same column and pressed CTRL-SHFT-ENTER to get a multi cell function I just dont know how to allocate results to the function so that it will show in the selected cells. What I've done so far is shown below:
Function ROM(ByVal lookup_value As Range, _
ByVal lookup_column As Range, _
ByVal return_value_column As Long) As String
Application.ScreenUpdating = False
Dim i As Long
Dim resultCount As Long
Dim resultsArray() As String
Dim arraySize As Long
Dim myrange As Range
Dim results As String
Dim TSS As Long
Dim OSS As Long
Dim AWS As Long
Dim JLI As Long
Dim answers(1 To 3, 1 To 1) As Variant
' The following code works out how many matches there are for the lookup and creates an
' array of the same size to hold these results
Set myrange = lookup_column
arraySize = Application.WorksheetFunction.CountIf(myrange, lookup_value.Value)
ReDim resultsArray(arraySize - 1)
' A counter for the results
resultCount = 0
TSS = 0
OSS = 0
AWS = 0
JLI = 0
' The equipment ID column is looped through and for every match the corresponding Equipment Type is
' saved into the resultsArray for analysis
For i = 1 To lookup_column.Rows.count
If Len(lookup_column(i, 1).Text) <> 0 Then
If lookup_column(i, 1).Text = lookup_value.Value Then
' If statement to ensure that the function doesnt cycle to a number larger than the
' size of resultsArray
If (resultCount < (arraySize)) Then
resultsArray(resultCount) = (lookup_column(i).Offset(0, return_value_column).Text)
results = (lookup_column(i).Offset(0, return_value_column).Text)
resultCount = resultCount + 1
' The following code compares the string to preset values and increments
' the counters if any are found in the string
If (InStr(results, "TPWS TSS") > 0) Then
TSS = TSS + 1
ElseIf (InStr(results, "TPWS OSS")) Then
OSS = OSS + 1
ElseIf (InStr(results, "JUNCTION INDICATOR (1 Route)") > 0) Then
JLI = JLI + 1
ElseIf (InStr(results, "AWS")) Then
AWS = AWS + 1
End If
End If
End If
End If
Next
answers(1, 1) = TSS
answers(1, 2) = OSS
answers(1, 3) = AWS
answers(1, 4) = 0
ROM = answers
Application.ScreenUpdating = True
End Function
When I try running the function it keeps saying type mismatch for answers. The cells selected for the multi cell formula are F18, G18, H18 and I18.

Answer 1

To return array functions from VBA
your function must be of type Variant
your output array must match the selected range - in your case it must be 1-dimensional
whereas you are dimensioning a 2-dimensional array
Try this
Function MyArray() As Variant
Dim Tmp(3) As Variant
Tmp(0) = 1
Tmp(1) = "XYZ"
Tmp(2) = 3
Tmp(3) = 4
MyArray = Tmp
End Function
Now select F18..I18, enter =MyArray() and press Ctrl+Shift+Enter
Hope this helps.

Answer 2

This may vary depending on the version of Excel you are using. I am using the Office2003 suite and the solutions presented above do not work with this version of Excel.
I find that you need a two diminsion array output to Excel with the values in the second diminsion.
I'll borrow MikeD's example above and modify it to work in Excel2003.
Function MyArray() As Variant
Dim Tmp() As Variant
redim Tmp(3,0) as Variant
Tmp(0,0) = 1
Tmp(1,0) = "XYZ"
Tmp(2,0) = 3
Tmp(3,0) = 4
MyArray = Tmp
End Function
Note that you can re-diminsion your array to use a dynamic output, but you must select a large enough range to encompass all of your output when you insert the function into Excel.

Answer 3

First, you're getting the type mismatch because you're trying to assign the result to a String. If you assign to a Variant you'll avoid that problem.
Second, your answers array should be dimensioned as:
Dim answers(3) As Variant
The following code should work for you if I've understood the problem correctly.
Function ROM(ByVal lookup_value As Range, _
ByVal lookup_column As Range, _
ByVal return_value_column As Long) As Variant
Application.ScreenUpdating = False
Dim i As Long
Dim resultCount As Long
Dim resultsArray() As String
Dim arraySize As Long
Dim myrange As Range
Dim results As String
Dim TSS As Long
Dim OSS As Long
Dim AWS As Long
Dim JLI As Long
Dim answers(3) As Variant
' The following code works out how many matches there are for the lookup and creates an
' array of the same size to hold these results
Set myrange = lookup_column
arraySize = Application.WorksheetFunction.CountIf(myrange, lookup_value.Value)
ReDim resultsArray(arraySize - 1)
' A counter for the results
resultCount = 0
TSS = 0
OSS = 0
AWS = 0
JLI = 0
' The equipment ID column is looped through and for every match the corresponding Equipment Type is
' saved into the resultsArray for analysis
For i = 1 To lookup_column.Rows.Count
If Len(lookup_column(i, 1).Text) <> 0 Then
If lookup_column(i, 1).Text = lookup_value.Value Then
' If statement to ensure that the function doesnt cycle to a number larger than the
' size of resultsArray
If (resultCount < (arraySize)) Then
resultsArray(resultCount) = (lookup_column(i).Offset(0, return_value_column).Text)
results = (lookup_column(i).Offset(0, return_value_column).Text)
resultCount = resultCount + 1
' The following code compares the string to preset values and increments
' the counters if any are found in the string
If (InStr(results, "TPWS TSS") > 0) Then
TSS = TSS + 1
ElseIf (InStr(results, "TPWS OSS")) Then
OSS = OSS + 1
ElseIf (InStr(results, "JUNCTION INDICATOR (1 Route)") > 0) Then
JLI = JLI + 1
ElseIf (InStr(results, "AWS")) Then
AWS = AWS + 1
End If
End If
End If
End If
Next
answers(0) = TSS
answers(1) = OSS
answers(2) = AWS
answers(3) = 0
ROM = answers
Application.ScreenUpdating = True
End Function