Excel vba - joining two arrays - excel

I need to join two arrays vd and vd1 into vdu.
ReDim vdu(1 To (UBound(vd, 1) + UBound(vd1, 1)), 1 To 1)
For i = 1 To UBound(vd, 1)
vdu(i, 1) = vd(i, 1)
Next i
For j = i To UBound(vdu, 1)
vdu(j, 1) = vd1(j - i + 1, 1)
Next j
First, I get and "out of range" error.
Second, in the end I will have 18 arrays that I'll need to join, so I don't know if this is the best idea for joining them.

try with
ReDim vdu(LBound(vd) To UBound(vd) + UBound(vd1), 1 To 1)
For i = LBound(vdu) To UBound(vdu)
If i <= UBound(vd) Then
vdu(i, 1) = vd(i, 1)
Else
vdu(i, 1) = vd1(i - UBound(vd), 1)
End If
Next i
Update for second part of question
I'd convert your merge code into a function
Public Function MergeArrays(arr1 As Variant, arr2 As Variant) As Variant
Dim i As Long
Dim arr As Variant
ReDim arr(LBound(arr1, 1) To UBound(arr1, 1) + UBound(arr2, 1), 1 To 1)
For i = LBound(arr, 1) To UBound(arr, 1)
If i <= UBound(arr1, 1) Then
arr(i, 1) = arr1(i, 1)
Else
arr(i, 1) = arr2(i - UBound(arr1, 1), 1)
End If
Next i
MergeArrays = arr
End Function
And then pass each array to it 1 at a time e.g.
arr = MergeArrays(vd1, vd2)
arr = MergeArrays(arr, vd3)
arr = MergeArrays(arr, vdx)
You could loop through this by storing your arrays in an array or dictionary and looping through that instead as well
Other option
Public Function MergeArrays(ParamArray arrays() As Variant) As Variant
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
This method uses a ParamArray. If you're not sure what that is look it up but effectively you're able to pass an unspecified amount of arguments to the function. Therefore with this function you can combine any amount of arrays (of the same shape and same base i.e. x to x, 1 to 1) and it will combine them. Call like
arr = MergeArrays(vd, vd1, vd2,....,vd18)

getMasterArray will return an array that combines up to 60 different 2d arrays into one. getMasterArray also give you the option of returning a 0 or based array.
Sub TestgetMasterArray()
Dim data
data = getMasterArray(False, Range("List1").Value, Range("List2").Value, Range("List3").Value, Range("List4").Value)
Worksheets("Result").Range("A1").Resize(UBound(data), UBound(data, 2)).Value = data
End Sub
Function getMasterArray(Base0 As Boolean, ParamArray Arrays() As Variant)
Dim result As Variant, v As Variant
Dim Count As Long, Count2 As Long, lowBound As Integer, lOffset As Integer, x As Long, x1 As Long, y As Long
For Each v In Arrays
Count = Count + UBound(v) + IIf(LBound(v) = 0, 1, 0)
y = UBound(v, 2) + IIf(LBound(v, 2) = 0, 1, 0)
If y > Count2 Then Count2 = y
Next
lowBound = IIf(Base0, 0, 1)
ReDim result(lowBound To Count, lowBound To Count2)
For Each v In Arrays
If LBound(v, 2) > LBound(result, 2) Then
lOffset = -1
ElseIf LBound(v, 2) < LBound(result, 2) Then
lOffset = 1
End If
For x = LBound(v) To UBound(v)
For y = LBound(v, 2) To UBound(v, 2)
result(lowBound, y + lOffset) = v(x, y)
Next
lowBound = lowBound + 1
Next
Next
getMasterArray = result
End Function
Sample data generated by ockaroo.com

Related

VBA: completing a matrix

I have a 3 by 3 matrix, where elements (1,1), (2,1), (2,2), (3,1), (3,2), (3,3) are given:
X . .
X X .
X X X
I need to write a program that writes out the missing elements, where (1,2)=(2,1), (1,3)=(3,1) and (2,3)=(3,2). I have written the following code:
Function kiegeszito(a)
For i = 1 To 3
For j = 1 To 3
If i < j Then
a(i, j) = a(j, i)
Else
a(i, j) = a(i, j)
End If
Next j
Next i
kiegeszito = a
End Function
However, this does not seem to work, could anybody help me why is this not working?
Just remove the Else condition:
Function kiegeszito(a)
For i = 1 To 3
For j = 1 To 3
If i < j Then a(i, j) = a(j, i)
Next j
Next i
kiegeszito = a
End Function
Get twin data in 2-dim matrix avoiding extra n*(n-1)/2 condition checks
The following approach
reduces the number of unnecessary condition checks by incrementing the 2nd loop starts
accepts any wanted base of 2-dim data:
Sub CompleteMatrix(ByRef data)
'count row|=column elements
Dim cnt As Long: cnt = UBound(data) - LBound(data) + 1
'fill missing twin data (identified by inverted indices)
Dim i As Long, j As Long
For i = LBound(data) To cnt - 1
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'next column starts from incremented row index
'(thus avoiding n*(n-1)/2 IF-conditions)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For j = i + 1 To UBound(data, 2)
data(i, j) = data(j, i) ' assign twin data
Next j
Next i
End Sub
An example call creating e.g. a 1-based 2-dim datafield array might be
Sub ExampleCall()
Dim v: v = Tabelle3.Range("A1:C3").Value
CompleteMatrix v
End Sub
Further link
A practical example using such a mirrored array might be a distance array; a related post demonstrates how to apply the FilterXML() function thereon.
Fill Array
Using a method (fillArray) you could modify the array 'in place':
The Code
Option Explicit
Sub fillArrayTEST()
Dim Data As Variant: Data = Range("A1:C3").Value
debugPrint2D Data
fillArray Data
debugPrint2D Data
End Sub
Sub fillArray(ByRef Data As Variant)
Dim cCount As Long: cCount = UBound(Data, 2)
Dim i As Long, j As Long
For i = 1 To UBound(Data, 1)
For j = 1 To cCount
If i < j Then Data(i, j) = Data(j, i)
Next j
Next i
End Sub
Sub debugPrint2D(ByVal Data As Variant)
Dim i As Long, j As Long
For i = LBound(Data, 1) To UBound(Data, 1)
For j = LBound(Data, 2) To UBound(Data, 2)
Debug.Print "[" & i & "," & j & "]", Data(i, j)
Next j
Next i
End Sub
A Homage to T.M.'s Brilliant Solution
Sub completeMatrix(ByRef Data As Variant)
Dim rLower As Long: rLower = LBound(Data, 1)
Dim cLower As Long: cLower = LBound(Data, 2)
Dim iDiff As Long: iDiff = cLower - rLower
Dim cStart As Long: cStart = iDiff + 1
Dim cUpper As Long: cUpper = UBound(Data, 2)
Dim r As Long, c As Long
For r = rLower To UBound(Data, 1) - rLower
For c = cStart + r To cUpper
Data(r, c) = Data(c - iDiff, r + iDiff)
Next c
Next r
End Sub
Sub completeMatrixTEST()
Dim Data As Variant: ReDim Data(0 To 2, 2 To 4)
Data(0, 2) = 1
Data(1, 2) = 2
Data(1, 3) = 3
Data(2, 2) = 4
Data(2, 3) = 5
Data(2, 4) = 6
debugPrint2D Data
completeMatrix Data
'Range("G1").Resize(UBound(Data, 1) - LBound(Data, 1) + 1, _
UBound(Data, 2) - LBound(Data, 2) + 1).Value = Data
Debug.Print
debugPrint2D Data
End Sub

Get all combinations of summing numbers

Column A in sheet1 has the values [1,2,3,4,5,6] in range("A1:A6") and what I am trying to do is to get all the combinations of summing each two numbers and each three numbers and each four numbers and each five numbers
This is what I did till now but the results are not as I expected
Sub Test()
Dim a, b, lr As Long, i As Long, j As Long, k As Long, ii As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lr
For j = i To lr
For ii = j To lr
Cells(i, ii + 1) = i & "+" & j & "+" & ii & "=" & i + j + ii
Next ii
Next j
Next i
With Range("A1").CurrentRegion
a = .Offset(, 1).Resize(, .Columns.Count - 1).Value
ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 1)
For i = LBound(a) To UBound(a)
For j = LBound(a, 2) To UBound(a, 2)
If a(i, j) <> "" Then
k = k + 1
b(k, 1) = a(i, j)
End If
Next j
Next i
.Cells(1, .Columns.Count + 2).Resize(k).Value = b
End With
End Sub
Example of the desired output:
Each two numbers together >>
Sub Test()
Dim a, b, lr As Long, i As Long, j As Long, k As Long, ii As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lr
For j = i To lr
Cells(i, j + 1) = i & "+" & j & "=" & i + j
Next j
Next i
With Range("A1").CurrentRegion
a = .Offset(, 1).Resize(, .Columns.Count - 1).Value
ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 1)
For i = LBound(a) To UBound(a)
For j = LBound(a, 2) To UBound(a, 2)
If a(i, j) <> "" Then
k = k + 1
b(k, 1) = a(i, j)
End If
Next j
Next i
.Cells(1, .Columns.Count + 2).Resize(k).Value = b
End With
End Sub
The results would be like that in column J
1+1=2
1+2=3
1+3=4
1+4=5
1+5=6
1+6=7
2+2=4
2+3=5
2+4=6
2+5=7
2+6=8
3+3=6
3+4=7
3+5=8
3+6=9
4+4=8
4+5=9
4+6=10
5+5=10
5+6=11
6+6=12
This is OK for each two numbers .. How can I get the results for each three numbers and for each four numbers and for each five numbers?
** #Vityata
Public Sub PrintArrayOnSingleLine(myArray As Variant)
Dim i As Long, x As Long
Dim textArray As String, temp As String
For i = LBound(myArray) To UBound(myArray)
textArray = textArray & myArray(i)
x = x + Val(myArray(i))
temp = temp & "+" & myArray(i)
Next i
Dim myLastRow As Long
myLastRow = LastRow(Worksheets(1).Name) + 1
ActiveSheet.Cells(myLastRow, 1) = Mid(temp, 2) & "=" & x
End Sub
I have edited the procedure as you told me, but just one note, I can't get the same number to be summed. Example: 1+1=2
Combination (not repeating same values):
Copy the code below and run it. Then change the variable in size = n. The given numbers are in the initialArray. In the end, instead of printing the array as a textArray, add a variable to sum it:
Sub Main()
Dim size As Long: size = 2
Dim initialArray As Variant: initialArray = Array(1, 2, 3, 4, 5, 6)
Dim arr As Variant: ReDim arr(size - 1)
Dim n As Long: n = UBound(arr) + 1
EmbeddedLoops 0, size, initialArray, n, arr
End Sub
Function EmbeddedLoops(index As Long, size As Long, initialArray As Variant, n As Long, arr As Variant)
Dim p As Variant
If index >= size Then
If Not AnyValueBiggerThanNext(arr) And Not AnyValueIsRepeated(arr) Then
PrintArrayOnSingleLine arr
End If
Else
For Each p In initialArray
arr(index) = p
EmbeddedLoops index + 1, size, initialArray, n, arr
Next p
End If
End Function
Public Function AnyValueBiggerThanNext(arr As Variant) As Boolean
Dim i As Long
For i = LBound(arr) To UBound(arr) - 1
If arr(i) > arr(i + 1) Then
AnyValueBiggerThanNext = True
Exit Function
End If
Next i
AnyValueBiggerThanNext = False
End Function
Public Function AnyValueIsRepeated(arr As Variant) As Boolean
On Error GoTo AnyValueIsRepeated_Error:
Dim element As Variant
Dim testCollection As New Collection
For Each element In arr
testCollection.Add "item", CStr(element)
Next element
AnyValueIsRepeated = False
On Error GoTo 0
Exit Function
AnyValueIsRepeated_Error:
AnyValueIsRepeated = True
End Function
Public Sub PrintArrayOnSingleLine(myArray As Variant)
Dim i As Long
Dim textArray As String
For i = LBound(myArray) To UBound(myArray)
textArray = textArray & myArray(i)
Next i
Debug.Print textArray
End Sub
Permutation (repeating same values)
Sub Main()
Static size As Long
Static c As Variant
Static arr As Variant
Static n As Long
size = 3
c = Array(1, 2, 3, 4, 5, 6)
n = UBound(c) + 1
ReDim arr(size - 1)
EmbeddedLoops 0, size, c, n, arr
End Sub
Function EmbeddedLoops(index, k, c, n, arr)
Dim i As Variant
If index >= k Then
PrintArrayOnSingleLine arr
Else
For Each i In c
arr(index) = i
EmbeddedLoops index + 1, k, c, n, arr
Next i
End If
End Function
Public Sub PrintArrayOnSingleLine(myArray As Variant)
Dim counter As Integer
Dim textArray As String
For counter = LBound(myArray) To UBound(myArray)
textArray = textArray & myArray(counter)
Next counter
Debug.Print textArray
End Sub
Sources (Disclaimer - from my blog):
VBA Nested Loop with Recursion
VBA All Combinations

Slice the first dimension from 2D array

I am trying to slice the first dimension of 2D array. The array variable is y (1 to 36, 1 to 19)
I need to make it y(1 to 12, 1 to 19)
To do such task I have to loop like that
If rw > 0 Then
ListBox1.AddItem
ReDim v(1 To n, 1 To UBound(y, 2))
Dim i As Long, j As Long
For i = 1 To n
For j = 1 To UBound(y, 2)
v(i, j) = y(i, j)
Next j
Next i
ListBox1.List = v()
n = 0
End If
Is there an easier way to do such task without too much loops?
You can slice an array as below. Most of this code is just to populate the first array so you won't need:
Sub x()
Dim v1(1 To 6, 1 To 3), i As Long, j As Long, v2()
'this loop is just to populate the first array
For i = 1 To UBound(v1, 1)
For j = 1 To UBound(v1, 2)
v1(i, j) = i * j
Next j
Next i
'this is just to show the contents
Range("A1").Resize(UBound(v1, 1), UBound(v1, 2)) = v1
'this does the slicing (first three rows
v2 = Application.Index(v1, Evaluate("row(1:3)"), Application.Transpose(Evaluate("row(1:" & UBound(v1, 2) & ")")))
'this shows the sliced array
Range("F1").Resize(UBound(v2, 1), UBound(v2, 2)) = v2
End Sub
you could use Tranpose():
Dim v As Variant, v1 As Variant
v = Range("A1").Resize(36, 19).Value' just to fill a 36x19 array
v1 = Application.Transpose(v)
ReDim Preserve v1(1 To UBound(v, 2), 1 To 12)
v = Application.Transpose(v1)

Custom INDEX function that can handle greater than 255 Characters

I am trying to use the Application.Index function with an variant 2D Array which contains some elements having >255 characters of text. This results in Variant/Integer Type Type Mismatch error. I am also unable to use Application.Transpose because of hitting this >255 characters limit.
Has anyone made any Custom INDEX UDFunction that can handle >255 characters of text to overcome this limit?
e.g.
The snippet code looks like this:
........
........
For j = 1 to NoOfSlides
A = (j - 1) * (nRw * 2) + 1
B = IIf(A >= UBound(Arr, 1), UBound(Arr, 1), (A + (nRw * 2)) - 1)
If B > UBound(Arr, 1) Then B = UBound(Arr, 1)
ab_Rng = Evaluate("row(" & A & ":" & B & ")")
TmpArr(j) = Application.Index(Arr, ab_Rng, Array(1, 2)) ' Type Mismatch Error
With oPres
Set oSlide = .slides("Slide0_ABC").Duplicate
oSlide.moveto toPos:=.slides.Count
With oSlide
....
End With
If getDimensions(TmpArr(j))<2 Then
TmpArr(j) = Application.Transpose(TransposeDim(TmpArr(j)) ) ' Error
End If
For y = LBound(TmpArr(j), 1) To UBound(TmpArr(j), 1)
.....
Next y
End With
Next j
........
........
Function getDimensions(var As Variant) As Long
On Error GoTo Err
Dim i As Long
Dim tmp As Long
i = 0
Do While True
i = i + 1
tmp = UBound(var, i)
Loop
Err:
getDimensions = i - 1
On Error GoTo 0
Err.Clear
End Function
Function TransposeDim(v As Variant) As Variant
' Convert 1D Array to 2D Array (1 -Based)
Dim x As Long, y As Long, Xupper As Long, Yupper As Long
Dim tempArray As Variant
on error resume next
Xupper = UBound(v, 2)
if err.number <>0 then
Redim Preserve v(1 to ubound(v), 1 to 1)
Xupper = UBound(v, 2)
endif
on error goto 0
Yupper = UBound(v, 1)
ReDim tempArray(1 To Xupper, 1 To Yupper)
For x = 1 To Xupper
For y = 1 To Yupper
tempArray(x, y) = v(y, x)
Next y
Next x
TransposeDim = tempArray
End Function
Edit:
Here is a Sample.xlsm file and a Sample PPT Template for anyone's perusal.
Dim a(1 To 2, 1 To 2) As String
Dim o As String
a(1, 2) = "testing " & String(255, "x")
o = Application.Index(a, 1, 2)
Debug.Print Len(o)
To support my comment, you are not using index correctly. I think you'll need to use your Array(1, 2)(0) and Array(1, 2)(1)
Interestingly, though strange enough, i found that as the Arr is defined as a Variant and pulls in Range data .e.g.
Arr = Sheet1.Range("A3:B8").Formula ' a Variant/Variant array
INDEX, TRANSPOSE, MATCH etc., will not work and result in Type MisMatch Error on hitting the >255 Characters limit. I think it internally uses an Integer index and therefore maintains a 255 character limit.
However, if i defined the Array Arr as a String:
' Define Arr as a String
ReDim Arr(1 To UBound(VarRng.Formula, 1), 1 To UBound(VarRng.Formula, 2)) As String
For x = LBound(VarRng.Formula, 1) To UBound(VarRng.Formula, 1)
For y = LBound(VarRng.Formula, 2) To UBound(VarRng.Formula, 2)
Arr(x, y) = CStr(VarRng.Formula(x, y))
Next y
Next x
'...then INDEX, TRANSPOSE, MATCH etc., will work properly, even though there are >255 Characters in the Array.
' Define Arr as a String
ReDim Arr(1 To UBound(VarRng.Formula, 1), 1 To UBound(VarRng.Formula, 2)) As String
For x = LBound(VarRng.Formula, 1) To UBound(VarRng.Formula, 1)
For y = LBound(VarRng.Formula, 2) To UBound(VarRng.Formula, 2)
Arr(x, y) = CStr(VarRng.Formula(x, y))
Next y
Next x
`Arr` is now a Variant/String
'....
'....
For j = 1 to NoOfSlides
A = (j - 1) * (nRw * 2) + 1
B = IIf(A >= UBound(Arr, 1), UBound(Arr, 1), (A + (nRw * 2)) - 1)
If B > UBound(Arr, 1) Then B = UBound(Arr, 1)
ab_Rng = Evaluate("row(" & A & ":" & B & ")")
TmpArr(j) = Application.Index(Arr, ab_Rng, Array(1, 2))
'....
Next j
Sample.xlsm and PPT Sample Template.pptx
Hope this helps.

INDEX(MATCH, MATCH) in VBA (Type 13 Type mismatch)

I'm trying to use an INDEX(MATCH,MATCH) to recreate this formula:
INDEX(Inflation!H$129:H$188,MATCH($J10,Inflation!$C$129:$C$188,0))
You may notice that the columns are not locked on the INDEX array field Inflation!H$129:H$188. I didn't know how to move over one column so I thought I would use an INDEX(MATCH,MATCH).
With my code below I get a error 13 Type Mismatch even if I swap out arrInflation_Bucket(I, 1) for "EWIP", a known entry in the searched range.
Sub Costs__Repossession_Costs()
Dim I, J, arrInflation_Bucket, arrInflation_Bucket_Label, arrNumber_of_Assets, arrQuarters, arrInflation_Label_Match, arrInflation_Quarter_Match
arrNumber_of_Assets = Range("Costs.Number_of_Assets")
arrQuarters = Range("Quarters_1to40")
arrInflation_Bucket = Range("Costs.Inflation_Bucket")
arrInflation_Bucket_Label = Range("Inflation.Inflation_Bucket_Label")
ReDim arrCosts__Repossession_Costs(1 To UBound(arrNumber_of_Assets, 1), 1 To UBound(arrQuarters, 2))
For I = LBound(arrInflation_Bucket, 1) To UBound(arrInflation_Bucket, 1)
For J = LBound(arrQuarters, 2) To UBound(arrQuarters, 2)
arrInflation_Label_Match(I, J) = Application.Match(arrInflation_Bucket(I, 1), Range("Inflation.Inflation_Bucket_Label"), 0)
arrInflation_Quarter_Match(I, J) = Application.WorksheetFunction.Match(arrQuarters(1, J), Range("Quarters_1to40"), 0)
arrCosts__Repossession_Costs(I, J) = Application.WorksheetFunction.Index(Range("Inflation.Cumulative"), arrInflation_Label_Match, arrInflation_Quarter_Match)
Next J
Next I
End Sub
This is by far the most complicated formula I will need to do in VBA so if I can get this it should be all smooth sailing.
OK, I've updated the code with he instructions of the first two comments, very helpful. It is now performing the two matches correctly (used to error out on the first, but now gives me row 48 adn column 1 which is correct) but Now Type 13 errors on the INDEX().
Sub Costs__Repossession_Costs()
Dim I As Long
Dim J As Long
Dim arrInflation_Bucket As Variant
Dim arrInflation_Bucket_Label, arrNumber_of_Assets, arrQuarters, arrInflation_Label_Match, arrInflation_Quarter_Match, arrInflation_Cumulative
arrNumber_of_Assets = Range("Costs.Number_of_Assets")
arrQuarters = Range("Quarters_1to40")
arrInflation_Bucket = Range("Costs.Inflation_Bucket")
arrInflation_Bucket_Label = Range("Inflation.Inflation_Bucket_Label")
arrInflation_Cumulative = Range("Inflation.Cumulative")
ReDim arrCosts__Repossession_Costs(1 To UBound(arrNumber_of_Assets, 1), 1 To UBound(arrQuarters, 2)), _
arrInflation_Label_Match(1 To UBound(arrNumber_of_Assets, 1), 1 To UBound(arrQuarters, 2)), _
arrInflation_Quarter_Match(1 To UBound(arrNumber_of_Assets, 1), 1 To UBound(arrQuarters, 2))
For I = LBound(arrInflation_Bucket, 1) To UBound(arrInflation_Bucket, 1)
For J = LBound(arrQuarters, 2) To UBound(arrQuarters, 2)
arrInflation_Label_Match(I, J) = Application.Match(arrInflation_Bucket(I, 1), Range("Inflation.Inflation_Bucket_Label"), 0)
arrInflation_Quarter_Match(I, J) = Application.WorksheetFunction.Match(arrQuarters(1, J), Range("Quarters_1to40"), 0)
arrCosts__Repossession_Costs(I, J) = Application.WorksheetFunction.Index(arrInflation_Cumulative, arrInflation_Label_Match, arrInflation_Quarter_Match)
Next J
Next I
End Sub
OK, so I caved like a you know what and asked my genius friend for help with this. His fantastic code is below:
Function firstMatchInRow(ByVal val, arr, ByVal col As Long) As Long
Dim i As Long
For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i, col) = val Then firstMatchInRow = i: Exit Function
Next i
End Function
Sub Costs__Repossession_Costs()
Dim i As Long, j As Long, tempLabelMatch As Long
Dim arrInflation_Bucket, arrInflation_Bucket_Label, arrNumber_of_Assets, arrQuarters, arrInflation_Cumulative, arrCosts__Repossession_Costs
arrQuarters = Range("Quarters_1to40")
arrInflation_Bucket = Range("Costs.Inflation_Bucket").Value
arrInflation_Bucket_Label = Range("Inflation.Inflation_Bucket_Label").Value
arrInflation_Cumulative = Range("Inflation.Cumulative").Value ' + add values
ReDim arrCosts__Repossession_Costs(1 To UBound(arrInflation_Cumulative, 1), 1 To UBound(arrQuarters, 2))
For i = LBound(arrInflation_Bucket, 1) To UBound(arrInflation_Bucket, 1)
tempLabelMatch = firstMatchInRow(arrInflation_Bucket(i, 1), arrInflation_Bucket_Label, 1)
For j = LBound(arrInflation_Cumulative, 2) To UBound(arrInflation_Cumulative, 2)
arrCosts__Repossession_Costs(i, j) = arrInflation_Cumulative(tempLabelMatch, j)
Next j
Next i
End Sub

Resources