Noob question: I want to count the non empty elements of an array?
My attempt:
Dim Arr(1 To 15) As Double
'populating some of the elements of Arr
'...
Dim nonEmptyElements As Integer, i As Integer
nonEmptyElements = 0: i = 0
For i = LBound(Arr) To UBound(Arr)
If Not Arr(i) = "" Then
nonEmptyElements = nonEmptyElements + 1
End If
Next
With this program I get the error: Type mismatch on If statement.
If try to change the if condition to If Not IsEmpty(Arr(i)) Then and i get nonEmptyElements = 15 as a result.
Any suggestions on how to complete the code?
Dim Arr(0 To 15) As Double
Arr(6) = 1.2
Arr(3) = 7
Dim nonEmptyElements As Integer, i As Integer
nonEmptyElements = 0 : i = 0
For i = LBound(Arr) To UBound(Arr)
If Not Arr(i) = 0 Then
nonEmptyElements = nonEmptyElements + 1
End If
Next
A double value by default is 0.0, so check if:
Arr(i) = 0
Application.CountA(myarray)
CountA is a worksheet function for counting non-empty values.
Applies only to VBA6, does not work in VBA7.
Related
I am an accountant and I need to match every customer payment against the outstanding invoices every day, I found a very nice and elegant VBA code published by Michael Schwimmer in this website. https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/accounts-receivable-problem
The code works perfect, it can automatically calculate and list the results that are added up to a specific sum. However, I would like the VBA code to returns the invoice numbers as well. The code passed an array of the values to a function for calculation and then returns the possible solution to Column E, I don't have knowledge in array so don't know how to pass the array of the invoice numbers to the function and return the results. Could anyone help? The code is as below, you can also download the excel workbook from the link I provided. Thanks in advance!
Private Sub cmbCalculate_Click()
Dim dGoal As Double
Dim dTolerance As Double
Dim dAmounts() As Double
Dim vResult As Variant
Dim m As Long
Dim n As Long
With Me
dGoal = .Range("B2")
dTolerance = .Range("C2")
ReDim dAmounts(1 To 100)
For m = 2 To 101
If (.Cells(m, 1) <> "") And (IsNumeric(.Cells(m, 1))) Then
dAmounts(m - 1) = .Cells(m, 1)
Else
ReDim Preserve dAmounts(1 To m - 1)
Exit For
End If
Next
ReDim Preserve dAmounts(1 To UBound(dAmounts) - 1)
vResult = Combinations(dAmounts, dGoal, dTolerance)
Application.ScreenUpdating = False
.Range("D3:D65536").ClearContents
.Range(.Cells(3, 4), .Cells(UBound(vResult) + 3, 4)) = vResult
Application.ScreenUpdating = True
End With
End Sub
Function Combinations( _
Elements As Variant, _
Goal As Double, _
Optional Tolerance As Double, _
Optional SoFar As Variant, _
Optional Position As Long) As Variant
Dim i As Long
Dim k As Long
Dim dCompare As Double
Dim dDummy As Double
Dim vDummy As Variant
Dim vResult As Variant
If Not IsMissing(SoFar) Then
'Sum of elements so far
For Each vDummy In SoFar
dCompare = dCompare + vDummy
Next
Else
'Start elements sorted by amount
For i = 1 To UBound(Elements)
For k = i + 1 To UBound(Elements)
If Elements(k) < Elements(i) Then
dDummy = Elements(i)
Elements(i) = Elements(k)
Elements(k) = dDummy
End If
Next
Next
Set SoFar = New Collection
End If
If Position = 0 Then Position = LBound(Elements)
For i = Position To UBound(Elements)
'Add current element
SoFar.Add Elements(i)
dCompare = dCompare + Elements(i)
If Abs(Goal - dCompare) < (0.001 + Tolerance) Then
'Goal achieved
k = 0
ReDim vResult(0 To SoFar.Count - 1, 0)
For Each vDummy In SoFar
vResult(k, 0) = vDummy
k = k + 1
Next
Combinations = vResult
Exit For
ElseIf dCompare < (Goal + 0.001 + Tolerance) Then
'Enough room for another element
'Call recursively starting with next higher amount
vResult = Combinations(Elements, Goal, Tolerance, SoFar, i + 1)
If IsArray(vResult) Then
Combinations = vResult
Exit For
Else
SoFar.Remove SoFar.Count
dCompare = dCompare - Elements(i)
End If
Else
'Amount too high
SoFar.Remove SoFar.Count
Exit For
End If
Next 'Try next higher amount
End Function
You could probably get the invoice numbers simply with a VLOOKUP but here is a VBA solution. I have changed the values in the Sofar collection from invoice amounts to the index number for that amount. That index number then gives the corresponding invoice number from a new array InvNo.
Update - Sorted by due date
Sub cmbCalculate_Click()
Dim ws As Worksheet, dAmounts() As Double, sInvno() As String
Dim i As Long, dSum As Double
Dim dtDue() As Date
Set ws = Me
i = ws.Cells(Rows.Count, "A").End(xlUp).Row
ReDim dAmounts(1 To i - 1)
ReDim sInvno(1 To i - 1)
ReDim dtDue(1 To i - 1)
' fill array
For i = 1 To UBound(dAmounts)
dAmounts(i) = ws.Cells(i + 1, "A")
sInvno(i) = ws.Cells(i + 1, "B")
dtDue(i) = ws.Cells(i + 1, "C")
dSum = dSum + dAmounts(i)
Next
' sort array
Call BubbleSort(dAmounts, sInvno, dtDue)
Dim n: For n = LBound(dAmounts) To UBound(dAmounts): Debug.Print n, dAmounts(n), sInvno(n), dtDue(n): Next
Dim dGoal As Double, dTolerance As Double, vResult As Variant
dGoal = ws.Range("D2")
dTolerance = ws.Range("E2")
' check possible
If dGoal > dSum Then
MsgBox "Error : Total for Invoices " & Format(dSum, "#,##0.00") & _
" is less than Goal " & Format(dGoal, "#,##0.00")
Else
' solve and write to sheet
vResult = Combinations2(dAmounts, sInvno, dtDue, dGoal, dTolerance)
If IsArray(vResult) Then
With ws
.Range("F3:H" & Rows.Count).ClearContents
.Range("F3").Resize(UBound(vResult), 3) = vResult
End With
MsgBox "Done"
Else
MsgBox "Cannot find suitable combination", vbCritical
End If
End If
End Sub
Function Combinations2( _
Elements As Variant, _
Invno As Variant, _
Due As Variant, _
Goal As Double, _
Optional Tolerance As Double, _
Optional SoFar As Variant, _
Optional Position As Long) As Variant
Dim i As Long, n As Long, dCompare As Double
' summate so far
If IsMissing(SoFar) Then
Set SoFar = New Collection
Else
For i = 1 To SoFar.Count
dCompare = dCompare + Elements(SoFar(i))
Next
End If
If Position = 0 Then Position = LBound(Elements)
For i = Position To UBound(Elements)
SoFar.Add CStr(i)
dCompare = dCompare + Elements(i)
' check if target achieved
If Abs(Goal - dCompare) < (0.001 + Tolerance) Then
'Goal achieved
Dim vResult As Variant
ReDim vResult(1 To SoFar.Count, 1 To 3)
For n = 1 To SoFar.Count
vResult(n, 1) = Elements(SoFar(n))
vResult(n, 2) = Invno(SoFar(n))
vResult(n, 3) = Due(SoFar(n))
Next
Combinations2 = vResult
ElseIf dCompare < (Goal + 0.001 + Tolerance) Then
'Enough room for another element
'Call recursively starting with next higher amount
vResult = Combinations2(Elements, Invno, Due, Goal, Tolerance, SoFar, i + 1)
If IsArray(vResult) Then
Combinations2 = vResult
Exit For
Else
SoFar.Remove SoFar.Count
dCompare = dCompare - Elements(i)
End If
Else
'Amount too high
SoFar.Remove SoFar.Count
Exit For
End If
Next
End Function
Sub BubbleSort(ByRef ar1 As Variant, ByRef ar2 As Variant, ByRef ar3 As Variant)
' sort both arrays
Dim d, s, i As Long, k As Long, dt As Date
For i = 1 To UBound(ar1)
For k = i + 1 To UBound(ar1)
If (ar1(k) < ar1(i)) Or _
(ar1(k) = ar1(i) _
And ar3(k) < ar3(i)) Then
d = ar1(i)
ar1(i) = ar1(k)
ar1(k) = d
s = ar2(i)
ar2(i) = ar2(k)
ar2(k) = s
dt = ar3(i)
ar3(i) = ar3(k)
ar3(k) = dt
End If
Next
Next
End Sub
Get nth match in Index
Please refer this exceljet page for function for getting nth match which is used in index function for finding the match for the nth position given by countif function as last argument of small function. Range in the countif function need to be fixed at the first cell only. So, when we copy the formula below we get relative increment in the 'n' in case of duplicate matches. So, Index function will give the incremental nth position value.
Array CSE(Control+Shift+Enter) Formula for in F3 and copy down
=INDEX(ColEResultRangeFixed,SMALL(IF(ColAValuesRangeFixed=ColEResultCriteria,ROW(ColAValuesRangeFixed)-MIN(ROW(ColAValuesRangeFixed))+1),COUNTIF($ColAValuesRangeFixedFirst,ColEResultCriteria)))
In this case.. CSE Formula in F3 and then copy down
=INDEX($B$2:$B$11,SMALL(IF($A$2:$A$11=E3,ROW($A$2:$A$11)-MIN(ROW($A$2:$A$11))+1),COUNTIF($E$3:E3,E3)))
I want to create a function plot_array(arr As Variant) which will create plot based on element in array.
On x axis I want to have numbers 1, 2,.., n which are indexes of array elements, and on y axis I want to have values stored in array. In other words
Example
Dim arr(9) As Variant
arr(0) = 0
arr(1) = 1
arr(2) = 5
arr(3) = 1
arr(4) = 5
arr(5) = 5
arr(6) = 1
arr(7) = 7
arr(8) = 6
plot_array(arr)
I tried to figure it about by running Macros and thinking how can I generalize this code to be working for any array, but I end up with nothing. Is there any possibility how it can be done ?
Try the next code, please. It will create a chart (xlLine type) and feed it with the array. You can change in the line .SeriesCollection.NewSeries.Values = arr1 arr1 with arr and obtain the same thing, if you put all the used number in the range "A1:A9":
Sub testPlotChartArray()
Dim sh As Worksheet, cH As Chart, arr1, arr(1 To 9)
Set sh = ActiveSheet
arr1 = sh.Range("A1:A9").Value
arr(1) = 0: arr(2) = 1: arr(3) = 5: arr(4) = 1: arr(5) = 5
arr(6) = 5: arr(7) = 1: arr(8) = 7: arr(9) = 6
On Error Resume Next
Set cH = sh.ChartObjects("PlotChart").Chart
If Err.Number = 0 Then
Err.Clear
cH.Parent.Delete
End If
On Error GoTo 0
Set cH = sh.ChartObjects.Add(left:=60, top:=10, width:=300, height:=300).Chart
With cH
.Parent.Name = "PlotChart"
.ChartType = xlLine
.SeriesCollection.NewSeries.Values = arr1 'or arr
End With
End Sub
The above code deletes the chart if it exists, but it can be configured to use the same existing chart and feed its .SeriesCollection(1).Values...
If you declare an array as arr(9) in Excel, the index is declared as a total of 10 arrays from 0 to 9, so your array is not the correct number.
Sub test()
Dim arr(8) As Variant
arr(0) = 0
arr(1) = 1
arr(2) = 5
arr(3) = 1
arr(4) = 5
arr(5) = 5
arr(6) = 1
arr(7) = 7
arr(8) = 6
plot_array (arr)
End Sub
Sub plot_array(arr As Variant)
Dim Srs As Series
Dim Cht As Chart
Dim xAxes As Axis, yAxes As Axis
Dim i As Integer, vX() As Variant
ReDim vX(LBound(arr) To UBound(arr))
For i = LBound(arr) To UBound(arr)
vX(i) = i + 1 '<~~ if index start from 0 then delete +1
Next i
Set Cht = ActiveSheet.Shapes.AddChart.Chart
With Cht
.HasTitle = True
.ChartTitle.Text = "My Graph"
.ChartType = xlXYScatterLinesNoMarkers
For Each Srs In .SeriesCollection
Srs.Delete
Next Srs
Set Srs = .SeriesCollection.NewSeries
With Srs
.Name = "item"
.Values = arr
.XValues = vX
.MarkerStyle = xlCircle
End With
Set xAxes = .Axes(xlCategory, xlPrimary)
With xAxes
.MinimumScale = 0
.MaximumScale = WorksheetFunction.Max(vX)
.MajorUnit = 1
.HasMajorGridlines = True
End With
Set yAxes = .Axes(xlValue, xlPrimary)
With yAxes
.MinimumScale = 0
.MaximumScale = WorksheetFunction.Max(arr) + 1
.MajorUnit = 1
.HasMajorGridlines = True
End With
End With
End Sub
I've been using stackoverflow as a great reference tool for VBA.
I've got 2, 2-column sets of data as shown below.
My goal is to have a user input data into those 2 columns, create a single 2-column array with that info, and remove blank rows from that array, and then create a drop-down containing the info from the first column of the combined array. The second column will be used for voltage references. (the header not being part of the array.)
What i've done is create 2 arrays at first, and combine them. I'm not sure if this is the best method, I need something that will work fast and I'm not sure how to properly remove the rows.
The code is below:
Sub test1()
Dim CombinedArray As Variant
Dim SWGRArray As Variant
Dim MCCArray As Variant
SWGRArray = Sheets("Worksheet").Range(Cells(3, 8), Cells(19, 9)).value
MCCArray = Sheets("Worksheet").Range(Cells(3, 10), Cells(19, 11)).value
CombinedArray = MergeArrays(SWGRArray, MCCArray)
End Sub
Public Function MergeArrays(ParamArray Arrays() As Variant) As Variant
' merges multiple arrays into a single array.
' ParamArray is an array listing other arrays
' Thanks to 'Tom' via https://stackoverflow.com/questions/46051448/excel-vba-joining-two-arrays
Dim i As Long, J As Long, cnter As Long, UBoundArr As Long, OldUBoundArray As Long
Dim arr() As Variant
For J = LBound(Arrays) To UBound(Arrays)
UBoundArr = UBoundArr + UBound(Arrays(J), 1)
Next J
ReDim arr(1 To UBoundArr, 1 To 1)
For J = LBound(Arrays) To UBound(Arrays)
For i = LBound(Arrays(J)) To UBound(Arrays(J))
arr(i + OldUBoundArray, 1) = Arrays(J)(i, 1)
Next i
OldUBoundArray = OldUBoundArray + UBound(Arrays(J), 1)
Next J
MergeArrays = arr
End Function
Stack Arrays
I was about to post this on the 16th, when right in front of my nose the post got deleted. So I'm sorry there are no comments, it was a long time ago.
Option Explicit
Function getStackedArrays(ByVal FirstIndex As Long, _
ParamArray Arrays() As Variant) _
As Variant
' Define Lower-Upper Array.
Dim UB As Long: UB = UBound(Arrays)
Dim LU As Variant: ReDim LU(3)
Dim lub As Variant
Dim i As Long
For i = 0 To 3: ReDim lub(0 To UB): LU(i) = lub: Next i
' Populate Lower-Upper Array and calculate dimensions of Result Array.
Dim uCount As Long, uCurr As Long
Dim lMax As Long, lCurr As Long
For i = 0 To UB
If IsArray(Arrays(i)) Then
GoSub calcIsArray
Else
GoSub calcNotArray
End If
GoSub countnMax
Next i
If lMax = 0 Or uCount = 0 Then Exit Function
' Define Result Array.
Dim UB1 As Long: UB1 = FirstIndex + uCount - 1
Dim UB2 As Long: UB2 = FirstIndex + lMax - 1
Dim Result As Variant: ReDim Result(FirstIndex To UB1, FirstIndex To UB2)
' Populate Result Array.
Dim k As Long, l As Long, m As Long, n As Long
m = FirstIndex
For i = 0 To UB
If IsArray(Arrays(i)) Then
GoSub writeResult
End If
Next i
' Write Result Array to Function Result.
getStackedArrays = Result
Exit Function
' Subroutines
calcIsArray:
If LBound(Arrays(i)) <= UBound(Arrays(i)) Then
LU(0)(i) = LBound(Arrays(i)): LU(1)(i) = UBound(Arrays(i))
On Error Resume Next
LU(3)(i) = LBound(Arrays(i), 2): LU(3)(i) = UBound(Arrays(i), 2)
On Error GoTo 0
End If
Return
calcNotArray:
If Not IsEmpty(Arrays(i)) Then
ReDim lub(0): lub(0) = Arrays(i): Arrays(i) = lub
LU(0)(i) = 0: LU(1)(i) = 0
End If
Return
countnMax:
uCurr = LU(1)(i) - LU(0)(i) + 1: uCount = uCount + uCurr
On Error Resume Next
lCurr = LU(3)(i) - LU(2)(i) + 1
If lCurr > lMax Then lMax = lCurr
On Error GoTo 0
Return
writeResult:
If Not IsEmpty(LU(0)(i)) And Not IsEmpty(LU(2)(i)) Then ' 2D
For k = LU(0)(i) To LU(1)(i)
n = FirstIndex
For l = LU(2)(i) To LU(3)(i)
Result(m, n) = Arrays(i)(k, l)
n = n + 1
Next l
m = m + 1
Next k
Else ' 1D
For k = LU(0)(i) To LU(1)(i)
Result(m, FirstIndex) = Arrays(i)(k)
m = m + 1
Next k
End If
Return
End Function
I am using Bloomberg sample code to collect data from Bloomberg through VBA (2d array?) and I have some old vba code that I believe takes a normal 3d array (maybe someone can clarify that for me). The problem is that Bloomberg output an array of elements.
See Bloomberg code below. Then below that is what I want to essentially convert the Bloomberg output into something that the next bit of code will accept.
Private Sub session_ProcessEvent(ByVal obj As Object)
On Error GoTo errHandler
Dim eventObj As blpapicomLib2.Event
Set eventObj = obj
If Application.Ready Then
If eventObj.EventType = PARTIAL_RESPONSE Or eventObj.EventType = RESPONSE Then
Dim it As blpapicomLib2.MessageIterator
Set it = eventObj.CreateMessageIterator()
Do While it.Next()
Dim msg As Message
Set msg = it.Message
Dim securityData As Element
Dim securityName As Element
Dim fieldData As Element
Set securityData = msg.GetElement("securityData")
Set securityName = securityData.GetElement("security")
Set fieldData = securityData.GetElement("fieldData")
Sheet1.Cells(currentRow, 4).Value = securityName.Value
Dim b As Integer
For b = 0 To fieldData.NumValues - 1
Dim fields As blpapicomLib2.Element
Set fields = fieldData.GetValue(b)
Dim a As Integer
Dim numFields As Integer
numFields = fields.NumElements
For a = 0 To numFields - 1
Dim field As Element
Set field = fields.GetElement(a)
Sheet1.Cells(currentRow, a + 5).Value = field.Name & " = " & field.Value
Next
currentRow = currentRow + 1
Next b
Loop
' skip a row for next security
currentRow = currentRow + 1
End If
End If
Exit Sub
errHandler:
MsgBox Err.Description
End Sub
This is the next bit of code I want the Bloomberg output to feed into.
Option Explicit
Dim Count() As Variant
Dim AdjCount() As Variant
Dim Rev() As Variant
Dim Conf() As Variant
Dim ncount() As Integer
Sub CreateSetupsBUY(series As Variant)
Dim x As Integer
Dim Y As Integer
Dim temp1 As Variant
Dim temp2 As Variant
Dim temp3 As Variant
Dim temp4 As Integer
Dim temp5 As Variant
ReDim Count(UBound(series))
ReDim AdjCount(UBound(series))
ReDim Rev(UBound(series))
ReDim Confn(UBound(series))
ReDim ncount(UBound(series))
For x = LBound(series) To UBound(series)
ReDim temp1(UBound(series(x)))
ReDim temp2(UBound(series(x)))
ReDim temp3(UBound(series(x)))
temp4 = 0
ReDim temp5(UBound(series(x)))
For Y = LBound(series(x)) + 5 To UBound(series(x))
If IsNumeric(series(x)(Y, 1)) Then
If series(x)(Y, 4) < series(x)(Y - 4, 4) Then
temp1(Y) = 1 + temp1(Y - 1)
Else
temp1(Y) = 0
End If
If series(x)(Y, 4) > series(x)(Y - 4, 4) Then
temp5(Y) = 1 + temp5(Y - 1)
Else
temp5(Y) = 0
End If
If temp1(Y) > 9 Then
temp2(Y) = 0
Else
temp2(Y) = temp1(Y)
End If
If temp1(Y) = 9 Then
temp4 = temp4 + 1
End If
If series(x)(Y - 1, 4) >= series(x)(Y - 5, 4) Then
temp3(Y) = 1
Else
temp3(Y) = 0
End If
Else
temp1(Y) = 0
temp2(Y) = 0
temp3(Y) = 0
temp4 = 0
temp5(Y) = 0
End If
Next Y
Count(x) = temp1
AdjCount(x) = temp2
Conf(x) = temp3
ncount(x) = temp4
Rev(x) = temp5
Next x
Call CreateCount(series, Count, Conf, ncount, Rev)
End Sub
When I tried connecting the two I get a type error. I assume its because of the way the Bloomberg array is created and unpacked.
Possible solution I have yet to try is to unpack the Bloomberg array and some how build a basic column row array while the Bloomberg array is unpacking.
I'm trying implement the next code and get the error -
cant assign to array
Where is the error ? Note that if i type Dim arrf() As Variant instead of Dim arrf(5) As Variant I get error -
type mismatch
Public Function calc(ByVal value As Integer, ByVal num As Integer) As Variant()
Dim arr(5) As Variant
Dim x As Double
If value >= num Then
x = value - Application.RoundDown(value / num, 0) * num
arr(0) = x
arr(1) = num - arr(0)
arr(2) = Application.RoundUp(value / num, 0)
arr(3) = 1
arr(4) = Application.RoundDown(value / num, 0)
arr(5) = 1
Else
x = num - Application.RoundDown(num / value, 0) * value
arr(0) = x
arr(1) = value - arr(0)
arr(2) = Application.RoundUp(num / value, 0)
arr(3) = 1
arr(4) = Application.RoundDown(num / value, 0)
arr(5) = 1
calc = arr
End If
End Function
Sub cellsfunc()
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
Dim lastrow As Integer
Dim counter As Integer
Dim arrf(5) As Variant
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
For counter = 2 To lastrow Step 2
arrf = calc(Cells(4, counter), Cells(4, counter + 1))
Next counter
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
thanks ahead to all helpers
You have arrf declared as a fixed size array:
Dim arrf(5) As Variant
An array returning function can't return a fixed size array - only a dynamic one. You just need to declare it as a dynamic array:
Dim arrf() As Variant
There's an issue in your function calc() : it only returns a value when it goes through the else, and not the if
It should probably be this:
Public Function calc(ByVal value As Integer, ByVal num As Integer) As Variant()
Dim arr(5) As Variant
Dim x As Double
If value >= num Then
x = value - Application.RoundDown(value / num, 0) * num
arr(0) = x
arr(1) = num - arr(0)
arr(2) = Application.RoundUp(value / num, 0)
arr(3) = 1
arr(4) = Application.RoundDown(value / num, 0)
arr(5) = 1
Else
x = num - Application.RoundDown(num / value, 0) * value
arr(0) = x
arr(1) = value - arr(0)
arr(2) = Application.RoundUp(num / value, 0)
arr(3) = 1
arr(4) = Application.RoundDown(num / value, 0)
arr(5) = 1
End If
calc = arr ' <------- THIS
End Function
If you use a typed array in VBA script always use ReDim.. size initialization. You may use a typed array in a dictionary value or everywhere like a regular variable.
Public Function readData(ws As Worksheet, arr As Scripting.Dictionary) As Boolean
Dim iRow as long
Dim key as String
Dim sVal() As String
ReDim sVal(0 to 1) as String
For iRow=2 to 1000
key = ws.cells(iRow,1)
sVal(0) = ws.Cells(iRow, 5)
sVal(1) = ws.Cells(iRow, 6)
call arr.Add(key, sVal)
Next
readData=true
End Function
Public Function writeData(ws As Worksheet, arr As Scripting.Dictionary) As Long
Dim iRow as long
Dim key as String
Dim sVal() As String
ReDim sVal(0 to 1) as String
For iRow=2 to 1000
key = ws.cells(iRow,1)
If arr.Exists(key) then
sVal = arr.Item(key)
ws.Cells(iRow, 5) = sVal(0)
ws.Cells(iRow, 6) = sVal(1)
End If
Next
writeData=true
End Function
You need to declare aarf as a regular variant not an array. The VBA will convert it for you.
Dim arrf As Variant