I have two jagged arrays containing information on some entities that I need to compare.
Dim MyArray1()
Dim MyArray2()
MyArray1(0) = Array("ID1", 2)
MyArray1(1) = Array("ID2", 7)
MyArray1(2) = Array("ID3", 5)
MyArray1(3) = Array("ID4", 3)
MyArray2(0) = Array("ID1", 5)
MyArray2(1) = Array("ID2", 8)
MyArray2(2) = Array("ID3", 6)
MyArray2(3) = Array("ID4", 9)
I'm looking for the best way of comparing these arrays, in this case I will need to get both the number difference between them. So ID1 = 3, ID2 = 1, etc. Any assistance would be greatly appreciated!
If both arrays will always have same size, then maybe would be easier to use dictionaries.
Excel VBA Dictionary – A Complete Guide
Sub COMPARING_VALUES()
Dim Dict1 As Object
Dim Dict2 As Object
Set Dict1 = CreateObject("Scripting.Dictionary")
Set Dict2 = CreateObject("Scripting.Dictionary")
With Dict1
.Add "ID1", 2
.Add "ID2", 7
.Add "ID3", 5
.Add "ID4", 3
End With
With Dict2
.Add "ID1", 5
.Add "ID2", 8
.Add "ID3", 6
.Add "ID4", 9
End With
Dim key As Variant
For Each key In Dict1.Keys
Debug.Print Dict2(key) - Dict1(key)
Next key
End Sub
In this case, you can use Dictionaries because you are relating data with an ID (that means a key), not just their position in array, so probably it's easier to use dictionaries.
Executing this code will print in debugger these values:
3
1
1
6
Hope you can adapt this to your needs.
Sub compJaggedArrs()
Dim MyArray1(0 To 3)
Dim MyArray2(0 To 3)
Dim i As Long, j As Long
MyArray1(0) = Array("ID1", 2)
MyArray1(1) = Array("ID2", 7)
MyArray1(2) = Array("ID3", 5)
MyArray1(3) = Array("ID4", 3)
MyArray2(0) = Array("ID1", 5)
MyArray2(1) = Array("ID2", 8)
MyArray2(2) = Array("ID3", 6)
MyArray2(3) = Array("ID4", 9)
For i = 0 To UBound(MyArray1)
For j = 0 To UBound(MyArray2)
If MyArray1(i)(0) = MyArray2(j)(0) Then
Debug.Print MyArray1(i)(0) & " difference is: " & abs(MyArray1(i)(1) - MyArray2(j)(1))
End If
Next j
Next i
End Sub
Of course you can output the differences in another way. Just didn't know what you wanted to do with the results, it now prints to the debug window
Related
I am new to VBA macro and need some experts help on meeting the below requirement.
I got a workbook containing 2 sheets called 'Data' and 'Stats'.
'Data' contains the values as below
'Stats' contains the values as below
On click on the button, I would like to do the below
Get the values in column A in 'Stats' sheet
Find all the matching rows in 'Data' Sheet
Find the smallest start time and put that in 'Stats' sheet against the stage value
Find the biggest end time and that in 'Stats' sheet against the stage value
Final output would be like below
Note: I do not have the MINIFS or MAXIFS in my installation.
Incase you dont have MINIFS and MAXIFS you can use array formulas like so:
={MIN(IF(Stats!A1=Data!$A$1:$A$1000,Data!$C$1:$C$1000))}
and
={MAX(IF(Stats!A1=Data!$A$1:$A$1000,Data!$B$1:$B$1000))}
The {} indicates, that this is a Array-Formula. Enter with Ctrl + Shift + Enter
No VBA needed.
Just use in your Stats worksheet the following formula for Start:
=MINIFS(Data!A:A,Data!C:C,Stats!A:A)
and the following for End:
=MAXIFS(Data!B:B,Data!C:C,Stats!A:A)
Please, the VBA solution, too. It will be very fast, using arrays, processing everything in memory and dropping the result at once:
Sub BringStats()
Dim shD As Worksheet, shS As Worksheet, lastRD As Long, lastRS As Long
Dim arrD, arrS, i As Long, k As Long, dict As Object, El As Variant
Set shD = Worksheets("Data")
Set shS = Worksheets("Stats")
lastRD = shD.Range("A" & rows.count).End(xlUp).row
lastRS = shS.Range("A" & rows.count).End(xlUp).row
arrD = shD.Range("A2:C" & lastRD).Value
arrS = shS.Range("A2:C" & lastRS).Value
Set dict = CreateObject("Scripting.dictionary")
'load the dictionary with unique keys and all corresponding date in a string, as item
For i = 1 To UBound(arrD)
If Not dict.Exists(arrD(i, 3)) Then
dict.Add arrD(i, 3), CDate(arrD(i, 1)) & ";" & CDate(arrD(i, 2))
Else
dict(arrD(i, 3)) = dict(arrD(i, 3)) & "|" & CDate(arrD(i, 1)) & ";" & CDate(arrD(i, 2))
End If
Next
Dim arr As Variant, minTime As Date, minPos As Long
For i = 1 To UBound(arrS)
If dict.Exists(arrS(i, 1)) Then
arr = Split(dict(arrS(i, 1)), "|") 'extract each pair of time stamps
If UBound(arr) > 0 Then
For Each El In arr 'extract the element containing minimum time
If minTime = 0 Then
minTime = TimeValue(Split(El, ";")(0)): minPos = k
Else
If TimeValue(Split(El, ";")(0)) < minTime Then minTime = TimeValue(Split(El, ";")(0)): minPos = k
End If
k = k + 1
Next
arrS(i, 2) = Split(arr(minPos), ";")(0): arrS(i, 3) = Split(arr(minPos), ";")(1) 'load the array with the minimum time correspondent values
Else
arrS(i, 2) = Split(dict(arrS(i, 1)), ";")(0): arrS(i, 3) = Split(dict(arrS(i, 1)), ";")(1)'loading the array in case of only one occurrence
End If
End If
minPos = 0: minTime = 0: k = 0 'reinitialize the used variables
Next i
'drop the processed array at once
shS.Range("A2").Resize(UBound(arrS), UBound(arrS, 2)).Value = arrS
End Sub
There can be a lot of the same 'stage' occurrences...
I have the following code and it gives me the error Type mismatch for the line of code «Split_dt_2 = Split(Split_dt_1, ",")». I'm not able to run through the code with F8 because it gives me the error right away so i can't give the exact value of «Split_dt_1» but it's always a date which has that form : [11/1/2019,12/1/2019].
My goal would be to obtain :
y_Dest = 2019 and m_Des = 11
Sub import_Redeem_Spread()
Workbooks.Open "C:\Users\106400\OneDrive\Documents\FTT\CDOPT_AB.xlsm"
Dim wksSource As Worksheet, wksDest As Worksheet
Set wksSource = Workbooks("CDOPT_AB.xlsm").Sheets(2)
Set wksDest = ThisWorkbook.Sheets(2)
Dim Split_dt_1() As String
Dim Split_dt_2() As String
Dim Split_dt_3() As String
Dim Split_dt_4() As String
nbRows = wksSource.Cells(Rows.Count, 1).End(xlUp).Row
nbDates = wksDest.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To nbRows
If wksSource.Cells(i, 16) = "CPG Taux Fixe" Then
For m = 7 To nbDates
Split_dt_1 = wksDest.Cells(m, 2)
Split_dt_2 = Split(Split_dt_1, ",")
Split_dt_3 = Split_dt_2(0)
Split_dt_4 = Split(Split_dt_3, "[")
y_Dest = Right(Split_dt_4(1), 4)
m_Dest = Left(Split_dt_4(1), 2)
y_source = Left(Cells(I, 3), 4)
m_Source = Right(Cells(I, 3), 2)
If y_Dest = m_Dest & y_Source = m_Source Then
For n = 4 To 15
wksDest.Cells(m, n) = wksSource.Cells(i, n)
Next n
End If
Next m
End If
Next i
End Sub
I tried «Dim Split_dt_2() As Variant» but it does noes solve the problem
and I tried
Split_dt_1 = wksDest.Cells(m, 2).value
Split_dt_2 = Split(Split_dt_1, ",")
and it still doesn't work
Thanks in advance!
Use a Variant when using Split to create the array instead of Diming it as a String array.
A Variant will take on the properties of an Array when the function you are using returns an Array.
Dim Split_dt_1 As Variant
Split_dt_1 = Split(wksDest.Cells(m, 2), ",")
I would ditch assigning the Arrays and all the intermediate steps altogether:
y_Dest = Year(Split(Split(wksDest.Cells(m, 2), ",")(0), "[")(0))
There are times when having those intermediate steps helps, but IMO, this isn't one of them.
I have a 2D array:
Dim twod_array() As Variant
Which I want to store values from two other arrays: e.g.:
Dim arrayone As Variant
arrayone = (1, 2, 3)
Dim arraytwo As Variant
arraytwo = (4, 5, 6)
I want to loop through each element of the above arrays and add them in the below manner:
Dim count As Long
count = 0
ReDim Preserve twod_array(1,0) // initial sizing
for i = 0 To UBound(arrayone)
for j = 0 To UBound(arraytwo)
twod_array(0,count) = arrayone(i)
twod_array(1,count) = arraytwo(j)
count = count + 1
ReDim Preserve twod_array(1, count) // dynamic resizing (doesnt work)
Next j
Next i
I know at some point I have to ReDim the 2D array which I believe I can do as follows:
ReDim Preserve twod_array(1, count)
The 1 allows me to specify 2 elements in the x-dimension and the count is incremented because I don't know how many elements each one-d array will have (I just set them equal to three in this example)
For some reason, I can only output the values twod_array(0,0) to twod_array(1,0) and the other ones are blank. I suspect this has to do with how I used ReDim
e.g. right now I'm only getting:
twod_array(0,0) = 1
twod_array(1,0) = 4
but not:
twod_array(0,1) = 1
twod_array(1,1) = 5
instead I get:
twod_array(0,1) = //blank
twod_array(1,1) = //blank
Can someone please help me understand why my code is not resizing the 2D array correctly so I can output all elements it collects?
maybe you're after this:
Option Explicit
Sub arrays()
Dim arrayOne As Variant, arrayTwo As Variant
arrayOne = Array(1, 2, 3)
arrayTwo = Array(4, 5, 6)
Dim i As Long
ReDim twod_array(1, UBound(arrayOne)) As Variant ' array sizing
For i = 0 To UBound(arrayOne)
twod_array(0, i) = arrayOne(i)
twod_array(1, i) = arrayTwo(i)
Next
End Sub
which outputs your desired output:
twod_array(0,0) = 1
twod_array(1,0) = 4
and
twod_array(0,1) = 2
twod_array(1,1) = 5
I am using VBA to store key and value associated with the key into dictionary.
Sub Dict_Example()
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 to 5
dict.Add i, some number
Next i
I would like to find the highest value and its associated key in dict.
For example, if dict = {1: 5, 2: 10, 3: 6, 4: 11, 5: 3} where 1,2,3,4,5 are keys and 5, 10, 6, 11, 3 are values then it should return 4:11.
How do I do this in VBA?
I would generate an array from the dict.items and use Max/Min function on that. Then loop keys and compare items against that.
Option Explicit
Public Sub Dict_Example()
Dim dict As Object, max As Long, min As Long, arr(), key As Variant, i As Long
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To 5
dict.Add i, i * Application.WorksheetFunction.RandBetween(0, 100)
Next i
max = Application.max(dict.items)
min = Application.min(dict.items)
For Each key In dict
Debug.Print key, dict(key)
If dict(key) = max Then Debug.Print "max= " & dict(key) & vbTab & "key= " & key
Next
Stop
End Sub
You could accomplish this by using a couple arrays to temporarily store your high and low values and associated keys as you iterated through the dictionary like this:
Sub test()
Dim dict As New Dictionary
Dim low(1 To 2)
Dim high(1 To 2)
Dim i As Long
Dim key
For i = 1 To 5
dict.Add i, 'some number
Next i
low(1) = dict.Keys(0)
low(2) = dict(dict.Keys(0))
high(1) = dict.Keys(0)
high(2) = dict(dict.Keys(0))
For i = 0 To dict.Count - 1
If dict(dict.Keys(i)) < low(2) Then
low(1) = dict.Keys(i)
low(2) = dict(dict.Keys(i))
ElseIf dict(dict.Keys(i)) > high(2) Then
high(1) = dict.Keys(i)
high(2) = dict(dict.Keys(i))
End If
Next i
Debug.Print low(1) & ":" & low(2) & vbCrLf & high(1) & ":" & high(2)
End Sub
But sorting like this would only work correctly for numeric values. #Ryan Wildry's comment is the way to go for generally sorting a dictionary, then you would grab your values using dict(dict.Keys(0)) and dict(dict.Keys(dict.Count - 1)) respectively where dict references your sorted dictionary.
EDIT:
You'll need to add a library reference to the Microsoft Scripting Runtime for this to work.
I'm brand new to using dictionaries and could do with a bit of help. I've got a table of data in range A1:C4
A B C
1 4 7
2 5 8
3 6 9
Is there any way of adding this tables directly into a dictionary?
Thanks in advance
Dim d As Scripting.Dictionary
Dim r As Excel.Range
Dim c As Excel.Range
Set d = New Scripting.Dictionary
Set r = Range("a1:c4")
For Each c In r.Cells
d.Add CStr(c.Address), c.Value
Next c
I think what you're probably looking for is a Multidimensional Array
A standard Array will hold a series of values in a list, and the value of any point in this list can be referenced, for example:
myArray = Array("One", "Two", "Three")
'The first value in an array is at position 0 unless otherwise specified
MsgBox myArray(0) 'Will open a message box with the value "One"
MsgBox myArray(1) 'Will open a message box with the value "Two"
MsgBox myArray(2) 'Will open a message box with the value "Three"
Whereas a standard array is one dimensional, using a Multidimensional Array allows you to add more than one dimension to this list. Put simply a two dimensional array will let you create a table of data.
dim myArray(1 to 3, 1 to 3) as Variant will create a two dimensional array, by also specifying '1 to 3' will allocate a set size and range of items that can be referenced in the array. Take for example this table:
A B C
D E F
G H I
To put this into a multidimensional array would be the following
Dim myArray(1 To 3, 1 To 3) As Variant
myArray(1, 1) = "A"
myArray(1, 2) = "B"
myArray(1, 3) = "C"
myArray(2, 1) = "D"
myArray(2, 2) = "E"
myArray(2, 3) = "F"
myArray(3, 1) = "G"
myArray(3, 2) = "H"
myArray(3, 3) = "I"
MsgBox myArray(2, 2) 'Will open a message box with the value "E"
Given you are looking to produce this from Range("A1:C4") you could use a loop to go through each cell create this:
Dim myArray(1 To 4, 1 To 3) As Variant
For Each c In Range("A1:C4")
myArray(c.Row, c.Column) = c.Value
Next c