I'm trying to compare two 2d arrays in VBA Excel.
Source:
1 2 3 4
4 5 6 2
3 3 4 4
Target:
4 5 3 2
1 2 3 4
3 7 7 5
Given the above two 2-d arrays which I will call source and target I want to compare each row from source with entire target and check if it exists in target. For
Example row 1 from source (1 2 3 4) would be considered a match as it would found in target (at row 2). So I need to compare each row in target for a given row from source. If row in source does not exist in target then I will need to make note of this some how in order to mark as not existing in target.
Something on the lines of (not actual code just idea):
For i to ubound(srcArray)
isFound = False
For j To ubound(trgArray)
If srcArray(i) = trgArray(j) Then
isFound = True
If Not isFound Then
//make note of some sort
I know approach worked ok for single dim. array. But trying to do this for 2d arrays in some sort of loop in VB or other method. Not too familiar with VB in Excel. I would also like to look at each row as entire array if possible rather than comparing each element for each array individually.
Here is an example of how to loop and compare the elements of a 2D array:
Sub ArrayCompare()
Dim MyArr1 As Variant, MyArr2 As Variant, X as long, Y as long
MyArr1 = [{1,2,3,4;4,5,6,2;3,3,4,4}]: MyArr2 = [{4,5,3,2;1,2,3,4;3,7,7,5}]
For X = LBound(MyArr1) To UBound(MyArr1)
For Y = LBound(MyArr1, 1) To UBound(MyArr1, 1)
If MyArr1(X, Y) = MyArr2(X, Y) Then MsgBox X & ":" & Y & ":" & MyArr1(X, Y)
Next
Next
End Sub
Here is my updated code to compare each row as a string (Thanks #Tim Williams :)):
Sub ArrayCompare()
Dim MyArr1 As Variant, MyArr2 As Variant, X As Long, Y As Long
MyArr1 = [{1,2,3,4;4,5,6,2;3,3,4,4}]: MyArr2 = [{4,5,3,2;1,2,3,4;3,7,7,5}]
For X = LBound(MyArr1) To UBound(MyArr1)
For Y = LBound(MyArr2) To UBound(MyArr2)
If Join(Application.Transpose(Application.Transpose(Application.Index(MyArr1, X, 0))), "|") = Join(Application.Transpose(Application.Transpose(Application.Index(MyArr2, Y, 0))), "|") Then MsgBox "Found a match at MyArr1 index:" & X & " and MyArr2 index:" & Y
Next
Next
End Sub
If you really want to avoid loops then you use this approach to extract a single "row" out of your 2-d array for comparison purposes, but it might be faster to loop.
Sub Tester()
Dim arr, rw
arr = Range("A1:J10").Value 'get 2-d array from worksheet
'get a 1-d array "row" out of the 2-d array
rw = Application.Transpose( _
Application.Transpose(Application.Index(arr, 1, 0)))
'then you can (eg) create a string for comparison purposes
Debug.Print Join(rw, Chr(0))
End Sub
Related
very new to VBA.
Suppose I have a 6 by 2 array with values shown on right, and I have an empty 2 by 3 array (excluding the header). My goal is to get the array on the left looks as how it is shown.
(Header) 1 2 3 1 a
a c e 1 b
b d f 2 c
2 d
3 e
3 f
Since the array on the right is already sorted, I noticed that it can be faster if I just let the 1st column of the 2 by 3 array take the first 2 values (a and b), the 2nd column takes the following 2 values (c and d), and so on. This way, it can avoid using a nested for loop to populate the left array.
However, I was unable to find a way to populate a specific column of an array. Another way to describe my question is: Is there a way in VBA to replicate this code from python, which directly modifies a specific column of an array? Thanks!
array[:, 0] = [a, b]
Populate Array With Values From Another Array
It is always a nested loop, but in Python, it is obviously 'under the hood' i.e. not seen to the end-user. They have integrated this possibility (written some code) into the language.
The following is a simplified version of what you could do in VBA since there is just too much hard-coded data with 'convenient' numbers in your question.
The line of your interest is:
PopulateColumn dData, c, sData, SourceColumn
to populate column c in the destination array (dData) using one line of code. It's just shorter, not faster.
Sure, it has no loop but if you look at the called procedure, PopulateColumn, you'll see that there actually is one (For dr = 1 To drCount).
You can even go further with simplifying the life of the end-user by using classes but that's 'above my paygrade', and yours at the moment since you're saying you're a noob.
Copy the code into a standard module, e.g. Module1, and run the PopulateColumnTEST procedure.
Note that there are results written to the Visual Basic's Immediate window (Ctrl+G).
The Code
Option Explicit
Sub PopulateColumnTEST()
Const SourceColumn As Long = 2
' Populate the source array.
Dim sData As Variant: ReDim sData(1 To 6, 1 To 2)
Dim r As Long
For r = 1 To 6
sData(r, 1) = Int((r + 1) / 2) ' kind of irrelevant
sData(r, 2) = Chr(96 + r)
Next r
' Print source values.
DebugPrintCharData sData, "Source:" & vbLf & "R 1 2"
' Populate the destination array.
Dim dData As Variant: ReDim dData(1 To 2, 1 To 3)
Dim c As Long
' Loop through the columns of the destination array.
For c = 1 To 3
' Populate the current column of the destination array
' with the data from the source column of the source array
' by calling the 'PopulateColumn' procedure.
PopulateColumn dData, c, sData, SourceColumn
Next c
' Print destination values.
DebugPrintCharData dData, "Destination:" & vbLf & "R 1 2 3"
End Sub
Sub PopulateColumn( _
ByRef dData As Variant, _
ByVal dDataCol As Long, _
ByVal sData As Variant, _
ByVal sDataCol As Long)
Dim drCount As Long: drCount = UBound(dData, 1)
Dim dr As Long
For dr = 1 To drCount
dData(dr, dDataCol) = sData(drCount * (dDataCol - 1) + dr, sDataCol)
Next dr
End Sub
Sub DebugPrintCharData( _
ByVal Data As Variant, _
Optional Title As String = "", _
Optional ByVal ColumnDelimiter As String = " ")
If Len(Title) > 0 Then Debug.Print Title
Dim r As Long
Dim c As Long
Dim rString As String
For r = LBound(Data, 1) To UBound(Data, 1)
For c = LBound(Data, 2) To UBound(Data, 2)
rString = rString & ColumnDelimiter & Data(r, c)
Next c
rString = r & rString
Debug.Print rString
rString = vbNullString
Next r
End Sub
The Results
Source:
R 1 2
1 1 a
2 1 b
3 2 c
4 2 d
5 3 e
6 3 f
Destination:
R 1 2 3
1 a c e
2 b d f
Alternative avoiding loops
For the sake of the art and in order to approximate your requirement to find a way replicating Python's code
array[:, 0] = [a, b]
in VBA without nested loops, you could try the following function combining several column value inputs (via a ParamArray)
returning a combined 2-dim array.
Note that the function
will return a 1-based array by using Application.Index and
will be slower than any combination of array loops.
Function JoinColumnValues(ParamArray cols()) As Variant
'Purp: change ParamArray containing "flat" 1-dim column values to 2-dim array !!
'Note: Assumes 1-dim arrays (!) as column value inputs into ParamArray
' returns a 1-based 2-dim array
Dim tmp As Variant
tmp = cols
With Application
tmp = .Transpose(.Index(tmp, 0, 0))
End With
JoinColumnValues = tmp
End Function
Example call
Assumes "flat" 1-dim array inputs with identical element boundaries
Dim arr
arr = JoinColumnValues(Array("a", "b"), Array("c", "d"), Array("e", "f"))
Is it possible to create multi dimensional array with different element types (string and integer)?
I tried like this but wan't work
BT = Range("A12")
ReDim IT(BT) As String
ReDim RBT(BT) As Integer
ReDim IT_RBT(IT, RBT) as ???? how to create multi dim array with different variables type
Range("B2").Select
i = 0
Do
i = i + 1
IT(i) = ActiveCell
RBT(i) = i
IT_RBT(i, i) = ???? how to enter values in such array ????
ActiveCell.Offset(1, 0).Select
Loop While ActiveCell <> ""
Thank you
Use a Variant array.
Dim values() As Variant
Now, your code is making assumptions that should be removed.
BT = Range("A12") '<~ implicit: ActiveSheet.Range("A12").Value
If you mean to pull the value of A12 from a particular specific worksheet, then you should qualify that Range member call with a proper Worksheet object. See CodeName: Sheet1 for more info, but long story short if that sheet is in ThisWorkbook you can do this:
BT = Sheet1.Range("A12").Value
And now assumptions are gone. Right? Wrong. BT isn't declared (at least not here). If it's declared and it's not a Variant, then there's a potential type mismatch error with that assignment. In fact, the only data type that can accept any cell value, is Variant:
Dim BT As Variant
BT = Sheet1.Range("A12").Value
Here, we're assuming BT is a numeric value:
ReDim IT(BT) As String
That's another assumption. We don't know that BT is numeric. We don't even know that it's a value that can be coerced into a numeric data type: we should bail out if that's not the case:
If Not IsNumeric(BT) Then
MsgBox "Cell A12 contains a non-numeric value; please fix & try again."
Exit Sub
End If
ReDim IT(BT) As String
Now that will work... but then, only the upper bound is explicit; is this a 0-based or a 1-based array? If the module says Option Base 1, then it's 1-based. Otherwise, it's 0-based - implicit array lower bounds are an easy source of "off-by-one" bugs (like how you're populating the arrays starting at index 1, leaving index 0 empty). Always make array bounds explicit:
ReDim IT(1 To BT) As String
Unclear why you need 3 arrays at all, and why you're only populating (i,i) in the 3rd one - you cannot populate a 2D array with a Do...Loop structure; you need every value of y for each value of x, and unless you hard-code the width of the array, that's a nested loop.
Moreover, looping on the ActiveCell and Selecting an Offset is making the code 1) very hard to follow, and 2) incredibly inefficient.
Consider:
Dim lastRow As Long
lastRow = Sheet1.Range("B" & Sheet1.Rows).End(xlUp).Row
ReDim values(1 To lastRow, 1 To 2) As Variant
Dim currentRow As Long
For currentRow = 2 To lastRow
Dim currentColumn As Long
For currentColumn = 1 To 2
values(currentRow, currentColumn) = Sheet1.Cells(currentRow, currentColumn).Value
Next
Next
Now, if we don't need any kind of logic in that loop and all we want is to grab a 2D variant array that contains every cell in B2:B???, then we don't need any loops:
Dim values As Variant
values = Sheet1.Range("A2:B" & lastRow).Value
And done: values is a 1-based (because it came from a Range), 2D variant array that contains the values of every cell in A2:B{lastRow}.
Note, code that consumes this array will need to avoid assumptions about the data types in it.
As #SJR has said, variant will allow for this. The below example is a easy example how to add different types to an array. Instead of x or y you can have a cell on a worksheet.
Dim array1() As Variant, i As Long
Dim x As String, y As Long
x = "5"
y = 1
For i = 1 To 10
ReDim Preserve array1(1 To 2, 1 To i)
array1(1, i) = x
array1(2, i) = y
y = y + 1
Debug.Print array1(1, i) & "," & array1(2, i) ' This is where you insert output
Next
You can do this:
BT = Range("A12")
ReDim IT(BT) As String
ReDim RBT(BT) As Integer
Dim IT_RBT(1 to 2) 'variant
IT_RBT(1) = IT 'add String array
IT_RBT(2) = RBT 'add Integer array
... this will keep your typed arrays functional but it's not a 2D array and you'd need to use notation like
IT_RBT(1)(1) 'String type
IT_RBT(2)(1) 'Integer type
I would like to be able to add some range of data in a dynamic multidimensional array without using a double loop that screens each element of the array. But I don't know if it is possible. By double loop, I mean such a code (this is only an example):
Dim Films(1 To 5, 1 To 2) As String
Dim i As Integer, j As Integer
For i = 1 To 5
For j = 1 To 2
Films(i, j) = Cells(i, j).Value
Next j
Next i
I am using VBA 2010. I know how many rows my array has, but the number of columns is variable.
Here is my code :
Sub DRS(Item)
'item is a name to search for in a specific range
Dim SrcRange() As Variant
Dim cell3 As Range
Dim n As Integer, m As Integer
SrcRange() = Array()
ReDim SrcRange(45, 0)
m = -1
n = 0
With Sheets("X")
For Each cell3 In .Range("I13:AG" & .Cells(1, Columns.Count).End(xlToRight).Column)
'the range ("I13:AG...") contains names, and some will match with "item"
m = m + 1
If Len(cell3.Value) > 0 And cell3 = Item Then
SrcRange(0, n) = .Range(m + 8 & "30:" & m + 8 & "75")
'the previous line **should** add a whole range of cells (which contain numbers, one by cell) in a colum of the array, but this is the line that doesn't work.
n = n + 1
ReDim Preserve SrcRange(UBound(SrcRange), n)
End If
Next cell3
End With
End Sub
I already tried those::
SrcRange(:, n) = .Range(m + 8 & "30:" & m + 8 & "75")
SrcRange(0:45, n) = .Range(m + 8 & "30:" & m + 8 & "75")
SrcRange(, n) = .Range(m + 8 & "30:" & m + 8 & "75")
but no one worked.
Is there a way or a formula that would allow me to add a full range of cells to each column of the array, or am I obliged to use a double loop to add the elements one by one?
I'm guessing that this Range...
.Range("I13:AG" & .Cells(1, Columns.Count).End(xlToRight).Column)
...should actually be xlToLeft instead of xlToRight (xlToRight will always return I13:AG16384).
I'm also not entirely sure what the m + 8 & "30:" & m + 8 & "75" is supposed to be evaluating to, because you increment the variable m each time through the loop, and it gives you ranges like 930:975. I'll take a stab in the dark and assume that the m + 8 is supposed to be the column that you found the item in.
That said, the .Value property of a Range object will just give you a 2 dimensional array. There isn't really any reason to build an array - just build a range and then worry about getting the array out of it when you're done. To consolidate the range (you only get the first area if you grab its Value), just copy and paste it to a temporary Worksheet, grab the array, then delete the new sheet.
Sub DRS(Item)
'item is a name to search for in a specific range
Dim SrcRange() As Variant
Dim found As Range
Dim cell3 As Range
With Sheets("X")
For Each cell3 In .Range("I13:AG" & .Cells(1, Columns.Count).End(xlToLeft).Column)
'the range ("I13:AG...") contains names, and some will match with "item"
If Len(cell3.Value) > 0 And cell3.Value = Item Then
If Not found Is Nothing Then
Set found = Union(.Range(.Cells(30, cell3.Column), .Cells(75, cell3.Column)), found)
Else
Set found = .Range(.Cells(30, cell3.Column), .Cells(75, cell3.Column))
End If
End If
Next cell3
End With
If Not found Is Nothing Then
Dim temp_sheet As Worksheet
Set temp_sheet = ActiveWorkbook.Sheets.Add
found.Copy
temp_sheet.Paste
SrcRange = temp_sheet.UsedRange.Value
Application.DisplayAlerts = False
temp_sheet.Delete
Application.DisplayAlerts = True
End If
End Sub
I have the following problem in Excel while calculating through a loop:
I need a variable (Destination Variable) that sequentially stores the results produced after each loop has been completed (avoiding the use of circular references) that would look like this:
'Let's call it "origin" variable in the worksheet
Origin Variable (50 x 50 array)
1 2 4
2 3 4
2 2 3
'Let's call it "destination" variable in the worksheet
Destination Variable (50 x 50 array)
1 1 1
1 1 1
1 1 1
After each loop, I'd need the macro to perform the following code:
range("destination").value = range("destination").value + range("origin").value
So that the destination variable would look like this after the current loop:
Destination Variable
2 3 5
3 4 5
3 3 4
However, Excel does not allow me to perform the previous function.
Does anyone have an answer how this could be solved?
Quite easy. I did this by recording as macro and tidying.
Sub Macro1()
Range("origin").Copy
Range("destination").PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
I like #S Meaden's answer, it is simple and I had not thought of that. And it certainly works for this purpose.
You could also do simple iteration. IN the example below I add two different ranges and put them in a third range, but this could be re-worked for your needs pretty easily, or it is another option if you ever need to add ranges to another range:
Sub AddArrays()
Dim rng1 As Range
Dim rng2 As Range
Dim rngSum As Range
Dim arr1 As Variant
Dim arr2 As Variant
Dim arrSum As Variant
Set rng1 = Range("A1:C7") '## Modify as needed
Set rng2 = Range("F1:H7") '## Modify as needed
Set rngSum = Range("K1:M7") '## Modify as needed
'Raises an error, Type Mismatch
'rngSum.Value = rng1.Value + rng2.Value
arr1 = rng1.Value
arr2 = rng2.Value
arrSum = rngSum.Value
Dim x As Integer, y As Integer
For x = LBound(arr1, 1) To UBound(arr1, 1)
For y = LBound(arr1, 2) To UBound(arr1, 2)
arrSum(x, y) = arr1(x, y) + arr2(x, y)
Next
Next
'Print result to sheet
rngSum.Value = arrSum
End Sub
I have a function which collects which months are ticked in a user form, containing checkboxes:
Function get_entries() As Boolean()
This returns a 2D boolean array(4, 11) representing 5 x 12 check boxes, which in turn represents months that are selected from a userform
In my main function:
Dim montharr() As Boolean
montharr = get_entries()
Call myfunc1(montharr(0))
Call myotherfunc(montharr(1))
Call myotherfunc(montharr(2))
Call myotherfunc(montharr(3))
Call myotherfunc(montharr(4))
I can't pass in the individual arrays of 12 elements to the subs successfully. I have tried declaring items as variants too but this isn't working and have spent ages trying to get this to work. Any thoughts welcome.
Here's one way to "slice" a 2-D array:
Sub ArraySlicing()
Dim arr(1 To 5, 1 To 5)
Dim slice
Dim x, y
Dim a As Application
For y = 1 To 5
For x = 1 To 5
arr(y, x) = "R" & y & ":C" & x
Next x
Next y
Set a = Application
'get first "column"
slice = a.Transpose(a.Index(arr, 0, 1))
Debug.Print Join(slice, ", ")
'get second "row" (note double transpose)
slice = a.Transpose(a.Transpose(a.Index(arr, 2, 0)))
Debug.Print Join(slice, ", ")
End Sub
Index() gives you a 2-d array - (x,1) or (1,x) - Transpose() will convert that to a 1-d array.