I modified the VBA code found at
checking if value present in array to the code below. A user will choose a field name and I want the code to find the column that field is listed in and create an array of all items in that column, but I want each non-blank value to show up only once in the array. I don't want any duplicates.
For example, if the column has values A, B, A, C, D, I want the code to return the array as A, B, C, D.
I get a run time error 13 - Type mismatch on this line of the code:
If cell.Value <> "" And IsError(WorksheetFunction.Match(cell.Value, MyArray, 0)) Then
I'm confused, because it seems like all my data types are correct. Can anyone offer any help?
Sub ChangeBlock()
Dim MyArray() As String
Dim cell As Range
Dim ColNum As Integer
Dim i As Integer
If Not Intersect(ActiveCell, Range("Block1")) Is Nothing Then
If ActiveCell.Value = "" Then Exit Sub
ColNum = WorksheetFunction.Match(ActiveCell.Value, Sheets("Budget Table").Range("A1:AG1"), 0)
For Each cell In Sheets("Budget Table").Columns(ColNum)
If cell.Value <> "" And IsError(WorksheetFunction.Match(cell.Value, MyArray, 0)) Then
ReDim Preserve MyArray(i)
MyArray(i) = cell.Value
i = i + 1
End If
Next
End If
MsgBox (MyArray)
End Sub
To use IsError, use Application.Match instead of WorksheetFunction.Match.
Although these two methods are similar, the way they handle errors is slightly different. The former returns an error variant that you can test with IsError, while the latter just throws an error that you can only catch with an error-handling mechanism.
Finally, if your data is large, this is not the optimal way to do the checking for duplicates; you should think of using a Dictionary.
The Error 13 Type mismatch is caused here:
cell.Value <> ""
The Value here is 2D-array something like (1 To 1048576, 1 To 1) and it is not possible to compare this array to a string hence the type mismatch.
Edit:
Actually the variable cell is a column so to compare properly it is necessary to say what element of the array is compared, e.g. for the first element:
cell.Value()(1, 1) = ""
More correct would be to rename the variable cell to e.g. oneColumn because the variable cell actually contains a reference to a column, e.g. like this:
Dim myColumns As Range
Set myColumns = Sheets("Budget Table").Columns(ColNum)
Dim oneColumn As Range
For Each oneColumn In myColumns
' ...
Next oneColumn
Note: Here the for-each does not make sense because myColumns references just one column and myColumns.Columns.Count returns 1. So all you wanted was actually myColumns.Cells which returns all the cells of the column.
The value of oneColumn is 2D-array and to be honest I don't know why it is 2D and not just 1D either. When you would examine Value of e.g. Range("A1:C3") then you see it returns 2D-array which is understandable. But why one column of columns returns 2D as well? Seems to be odd to me as well :). An example of 1D-array would be Dim oneDArray: oneDArray = Array("A", "B", "C"). As far as I know 1D-array is never returned from a Range.Value property. Here interesting article about array dimensions in VBA.
But this is not necessary because each Range has a property Cells. So here the Columns(ColNum).Cells should be used.
The complete code could look something like the following but it is a little bit too complicated. First the array has a lot of empty elements because the whole column is used and second consider the solution with a dictionary like #A.S.H is proposing. HTH
Dim MyArray() As String
Dim cell As Range
Dim ColNum As Integer
Dim i As Integer
ReDim MyArray(0 To 0)
With Sheets("Budget Table")
If Intersect(ActiveCell, .Range("Block1")) Is Nothing Then _
Exit Sub
If ActiveCell.Value = "" Then _
Exit Sub
ColNum = Application.Match(ActiveCell.Value, .Range("A1:AG1"), 0)
For Each cell In .Columns(ColNum).Cells
If cell.Value = "" Then _
GoTo continue
If IsError(Application.Match(cell.Value, MyArray, 0)) Then
If i > 0 Then
ReDim Preserve MyArray(i)
End If
MyArray(i) = cell.Value
i = i + 1
End If
continue:
Next cell
End With
Related
I am new to VBA. So usually I have to research stuff for my codes in order to make them work.
Now I am working on a code that has to get the values from cells with background colour that are different from -4142, and then putting those values in an array so that later I can insert those values in a dropdown list.
I was testing getting the values of the cells with different colours and putting them into arrays with the code I found in the answer of this question:
Appending a dynamic array in VBA
but for some reason, when I run the code I get the error 13 incompatible types (I don't know if the error message is that in english because my vba is in another language, but the error number is 13 non the less), in the line myArray(X) = cell.Address
It may be very silly but I dont know what to do.
Sub SelectByColor()
Dim cell As Range
Dim rng As Range
Dim LR As Long
Dim myArray() As Double, X As Long
X = 0
'For understanding LR = Last Row
LR = Range("B:B").SpecialCells(xlCellTypeLastCell).Row
ReDim Preserve myArray(X)
Set rng = Range("B2:B" & LR)
For Each cell In rng.Cells
If cell.Interior.ColorIndex <> -4142 Then
myArray(X) = cell.Address
X = X + 1
If X < N Then ReDim Preserve myArray(0 To X)
mystr = mystr & cell.Address & ","
End If
Next cell
mystr = Left(mystr, Len(mystr) - 1)
MsgBox mystr
MsgBox myArray(X)
End Sub
The mystr part is to see if the code would be getting the correct values, and it is, but it is not appending in the array.
(a) You get your runtime error because you declares your array to hold numbers, but you are trying to write addresses (=strings) into it. An cell address (eg $A$1) cannot be converted into a number and therefore VBA throws that error 13.
(b) A list of values used as Data Validation can be created by a range of cells or by a (hardcoded) list of values. However, the range need to be contiguous, which is not the case for your requirements.
So what you need is a list of values. The values need to be separated by ",". You can do the by creating an array as you do in your code and then use the Join-function. However, the array needs to be of type String or Variant, it will not work with Double.
As I don't like to use Redim Preserve in a Loop (very inefficient), I changed the logic by sizing the array with the maximum of possible values (LR) and then use only a single Redim to remove unused entries after the values are filled.
ReDim myArray(LR)
Dim X As Long, rng as Range, cell as Range
Set rng = ActiveSheet.Range("B2:B" & LR)
For Each cell In rng.Cells
If cell.Interior.ColorIndex <> -4142 and not isError(cell.value) Then
myArray(X) = cell.Value
X = X + 1
End If
Next cell
Redim Preserve myArray(X) ' Remove unused entries
Set the validiation:
With Selection.Validation ' <-- Replace Selection with the Range where you want to apply the validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(myArray, ",")
End With
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'm trying to write a little loop to check if a selected range contains any of the values in the Array.
Sub test()
Dim DirArray As Variant
Dim i As Integer
'define array
DirArray = Sheets("Blad1").Range("A1:A311").Value
'Loop trough array
For i = 1 To UBound(DirArray)
'Activate the sheet with the Range
Sheets("Blad1").Activate
'Go through range of values
If DirArray = Cells(i, 2) Then
MsgBox "it contains the value"
End If
Next i
End Sub
I think I'm making the error by using Cells(i,2), it says the Types don't match. I've been looking at it for so long I think I'm missing something obvious.
Any help or feedback would be appreciated!
Sub test()
Dim i As Integer, z, DirArray As Variant
With Sheets("Blad1")
'Define array
DirArray = .Range("A1:A311").Value
'Loop trough array
For i = 1 To UBound(DirArray)
'// Use Excel's Match function:
'// if the value of 'z' is not Error, then match is found.
'// Note that if you use WorksheetFunction.Match instead of
'// Application.Match and the value won't be found, then
'// error will be raised, in which case you need to use error handler.
'// To avoid this ceremony, use Application.Match since it won't raise
'// error, but the value of 'z' will just contain Error.
z = Application.Match(.Cells(i, 2), DirArray, 0)
If Not IsError(z) Then
MsgBox "it contains the value"
End If
Next i
Next
End Sub
Just for demonstration practices, I wanted to show you wouldn't need any (visible) loop to compare two 1D-arrays to return if any of the elements in one array is found in the other array.
To do so we can use the following code:
Sub Test()
Dim arr1 As Variant: arr1 = Array("A", "B", "C", "D")
Dim arr2 As Variant: arr2 = Array("D", "E", "B")
With Application
If .Count(.Match(arr2, arr1, 0)) > 0 Then
MsgBox "It contains values from arr1"
Else
MsgBox "It does not contain values from arr1"
End If
End With
End Sub
What does this actually do? Application.Match is able to compare two arrays, so in this case effectively you could think of:
.Match({"D", "E", "B"}, {"A", "B", "C", "D"}, 0)
It will compare each element in the first array against all elements in the second array, and most importantly it will return an array on it's own with the results:
Results = {4, Error 2042, 2}
As #JohnyL also explained, using Application.Match will not raise an run-time error when values are not found, it will continue and will put non-found matches in the array itself, showing an error in the results instead.
Now to check if there are any result we would need Application.Count to return the number of numeric values withing the resulting array.
.Count({4, Error 2042, 2})
In this case the result will be 2, telling us (higher than zero) that there are two values that have got a match.
How would this help OP?
In his case we would need one more function to return two 1D-arrays directly from the Range objects. Op seems to compare Range("A1:A311") against Range("B1:B311") so we could try the below:
Sub Test2()
Dim arr1 As Variant: arr1 = Sheets("Blad1").Range("A1:B311").Value
With Application
If .Count(.Match(.Index(arr1, 0, 1), .Index(arr1, 0, 2), 0)) > 0 Then
MsgBox "It contains values from arr1"
Else
MsgBox "It does not contain values from arr1"
End If
End With
End Sub
The only extra method I used was Application.Index to slice two 1D-arrays directly from the full 2D-array.
Another technique would be to use Application.Transpose if both A and B column would be of different size. You would pull them into a seperate variant variable and Transpose them once into a 1D-array.
This is my first time using array in VBA. I was trying to check the value of my array based on certain condition.
I check my array value through the Locals Window. The window is empty. What did I do wrong?
Option Explicit
Sub test()
'define dynamic array
Dim sn As Variant
Dim i As Long
'Loop through all the row
For i = 1 To Rows.Count
If Cells(i, 12).Value = "Renewal Reminder" And Not IsEmpty(Cells(i, 12).Value) Then
'assign cell value to array
sn = Cells(i, 1).Value
Debug.Print "aaa" ' there are 8 cell values that meet the condition
End If
Next i
End Sub
Update
Dim sn as Varient was highlighted with Error
user-defined type not defined
Apart from the typo showing in the error message, you are not actually using sn as an array - you are simply storing each value in a scalar variable, replacing what was previously in that variable.
The following should work for you:
Option Explicit
Sub test()
'define dynamic array
Dim sn As Variant
Dim cnt As Long
Dim i As Long
ReDim sn(1 To 1)
cnt = 0
'Loop through all the row
For i = 1 To Cells(Rows.Count, "L").End(xlUp).Row
If Cells(i, 12).Value = "Renewal Reminder" Then
'assign cell value to array
cnt = cnt + 1
ReDim Preserve sn(1 To cnt)
sn(cnt) = Cells(i, 1).Value
Debug.Print "aaa" ' there are 8 cell values that meet the condition
End If
Next i
For i = 1 To cnt
Debug.Print sn(i)
Next
End Sub
As mentioned in the answer by Chemiadel, it is better to declare your variables using the appropriate base type if you know what that is.
So, if you know that column A contains text, replace Dim sn As Variant with
Dim sn() As String
or, if it is a double-precision number, use
Dim sn() As Double
etc. If column A could contain various different types, using Variant could be appropriate.
Note: You don't have to include the () when using Variant because Variant variables can switch happily between being scalars, arrays, objects, etc.
You need to declare Array with this way and avoid Variant data type :
Static Array : fixed-size array
dim sn(10) as String
Dynamic Array : you can size the array while the code is running.
dim sn() as String
Use ReDim Preserve to expand an array while preserving existing values
ReDim Preserve sn(UBound(sn) + 10)
Check the reference
Problem: I am comparing two columns of names. If a name from the primary column matches a name in the secondary column, then I would like to add the matching name to an array of strings.
Function 1: This boolean function should indicate whether there is a match:
Function Match(name As String, s As Worksheet, column As Integer) As Boolean
Dim i As Integer
i = 2
While s.Cells(i, column) <> ""
If s.Cells(i, column).Value = name Then
Match = True
End If
i = i + 1
Wend
Match = False
End Function
Function 2: This function should add the matching name to a dynamic array of strings. Here I am somewhat stuck as I am new to arrays- any suggestions?
Function AddToArray(ys) As String()
Dim a() As String
Dim size As Integer
Dim i As Integer
Dim sh As Worksheet
Dim rw As Range
size = 0
ReDim Preserve a(size)
For Each rw In sh.Rows
If Match(sh.Cells(rw.Row, 1), s, column) = True Then
??
size = size + 1
End Function
Here is one solution. I scrapped your Match function and replaced it with a Find function.
Option Explicit
Sub AddToArray()
Dim primaryColumn As Range, secondaryColumn As Range, matchedRange As Range
Dim i As Long, currentIndex As Long
Dim matchingNames As Variant
With ThisWorkbook.Worksheets("Sheet1")
Set primaryColumn = .Range("A1:A10")
Set secondaryColumn = .Range("B1:B10")
End With
'Size your array so no dynamic resizing is necessary
ReDim matchingNames(1 To primaryColumn.Rows.Count)
currentIndex = 1
'loop through your primary column
'add any values that match to the matchingNames array
For i = 1 To primaryColumn.Rows.Count
On Error Resume Next
Set matchedRange = secondaryColumn.Find(primaryColumn.Cells(i, 1).Value)
On Error GoTo 0
If Not matchedRange Is Nothing Then
matchingNames(currentIndex) = matchedRange.Value
currentIndex = currentIndex + 1
End If
Next i
'remove unused part of array
ReDim Preserve matchingNames(1 To currentIndex - 1)
'matchingNames array now contains just the values you want... use it how you need!
Debug.Print matchingNames(1)
Debug.Print matchingNames(2)
'...etc
End Sub
Extra comments
There is no need to create your own Match function because it already exists in VBA:
Application.Match()
WorksheetFunction.Match()
and as I mentioned above you can also achieve the same result with the Find function which is my preference here because I prefer the way you can check for no matches (other methods throw less convenient errors).
Finally, I also opted to restructure your code into one Sub rather than two Functions. You weren't returning anything with your AddToArray function which pretty much means by definition it should actually be a Sub
As I stated in a comment to the question, there are a couple of problems in your code before adding anything to the array that will prevent this from working, but assuming that this was caused by simplifying the code to ask the question, the following should work.
The specific question that you are asking, is how to populate the array while increasing its size when needed.
To do this, simply do this:
Instead of:
ReDim Preserve a(size)
For Each rw In sh.Rows
If Match(sh.Cells(rw.Row, 1), s, column) = True Then
Reorder this so that it is:
For Each rw In sh.Rows
If Match(sh.Cells(rw.Row, 1), s, column) = True Then
ReDim Preserve a(size) 'increase size of array
a(size) = sh.Cells(rw.Row,1) 'put value in array
size = size + 1 'create value for size of next array
End If
Next rw
....
This probably isn't the best way to accomplish this task, but this is what you were asking to do. First, increasing the array size EVERY time is going to waste a lot of time. It would be better to increase the array size every 10 or 100 matches instead of every time. I will leave this exercise to you. Then you could resize it at the end to the exact size you want.