What is causing array type mismatch? - arrays

I am using a for loop to create an array containing valid order numbers that will then be used as search criteria for another query table. The next for loop searches for each order number in the previously created array and deletes the row if it is not in the array. I'd like to know why I'm getting a type mismatch error in the conditional statement line of the search function. I tried declaring the array as both a variant and as an array with individual string elements. Here is the trimmed down code, thanks in advanced!
Sub VistaArray()
Dim n As Integer, lastrow As Integer, ordern As String, vista() As Variant
'ADDING NEW ELEMENTS TO ORDER NUMBER ARRAY
For n = 2 To lastrow
i = n - 2
ReDim Preserve vista(i)
ordern = Worksheets(Sheet1).Cells(n, 1).Value
vista(i) = ordern
Next n
'REMOVING LINES FROM SECOND TABLE THAT AREN'T IN THE ARRAY
lastrow = Worksheets(Sheet2).Range("A1").End(xlDown).Row
For n = 2 To lastrow
ordn = ActiveSheet.Cells(n, 1).Value
If IsInArray(ordn, vista) Then
Else
'...REMOVE LINE FROM QUERY TABLE...
End If
Next n
End Sub
Function IsInArray(ordn As String, vista As Variant) As Boolean
IsInArray = (UBound(Filter(ordn, vista)) > -1) '***ERROR OCCURS ON THIS LINE***
End Function

The function Filter expects an array for its first argument and a string for its second. You have that reversed. The following should work:
Function IsInArray(ordn As String, vista() As Variant) As Boolean
IsInArray = (UBound(Filter(vista, ordn)) > -1)
End Function

Related

Pass of `ByVal` argument to Regex function leads to very slow code , although using Array

I am using this Regex function to (Remove numeric characters from end of string if count of numbers >= 9),
Function Remove_Number_Regex(Text As String) As String
'Remove numbers from end of string if count of numbers(characters) >= 9
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "\d{9,}(?=\.\w+$)"
Remove_Number_Regex = .Replace(Text, "")
End With
End Function
I tried on excel (as formula) and it works as it should without any error.
Then I used it inside vba using Array , but I got this error
Compile error: ByRef argument type mismatch
I fixed that error by passing ByVal argument to the declaration of Regex function
Function Remove_Number_Regex(ByVal Text As String) As String
And that leads to a very slow code to finish 18 seconds on (10K row) ,although using any other text function inside the same array takes 0.4 seconds to finish.
In advance, grateful for any helpful comments and answers.
Sub Use_Function_Remove_Number_Regex()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim arg As Range, arr
With ActiveSheet
Set arg = .Range("O1", .Cells(.Rows.Count, "R").End(xlUp)) '10k rows
End With
arr = arg.value
Dim r As Long, j As Long
For j = 1 To 4
For r = 1 To UBound(arr)
arr(r, j) = Remove_Number_Regex(arr(r, j))
Next r
Next j
arg.value = arr
Application.Calculation = xlCalculationAutomatic
End Sub
Generally speaking; using regular expressions will slow things down. You are correct that common string-operations are faster. So, why not use them:
Function Remove_Number(Text As String) As String
Dim nr As String: nr = CStr(Val("1" & StrReverse(Split(Text, ".")(0))))
If Len(nr) > 9 Then
Remove_Number = Replace(Text, StrReverse(Mid(nr, 2)) & ".", ".")
Else
Remove_Number = Text
End If
End Function
To test this function based on your previous question:
Sub Test()
Dim arr As Variant: arr = Array("Anomaly - allhelipads1335023398818.doc", "Anomaly - oilpipingW8.doc")
For Each el In arr
Debug.Print Remove_Number(CStr(el))
Next
End Sub
Returns:
The trick used:
Split your input based on the dot, and return the 1st element from the array (zero based);
Reverse the string;
Extract the numeric value when concatenated with a '1' (to prevent trailing zeros to disappear);
Check if length is more than 9 (accounting for the '1') and if so replace the value accordingly.
Note: Depending on your version of Excel, you could just stay away from VBA alltogether. See my answer to your previous question.

VBA check if whole row of multidimensional variant is empty without loops

Is there a quick way to check whether a whole row of a variant is empty?
My multi-dimensional array / variant has n-rows and m-columns.
The only way I can think of is to loop through the columns (of a specific row) and use the IsEmpty() function to determine if a cell is empty.
The variant only consists strings.
Do you know a faster way? Maybe something like this pseudo-code: IsEmpty(myarr(1,*))
this pseudocode would mean to check the all columns of the first row if they are empty.
You could try something like:
Sub Test()
Dim myarr() As Variant, indx As Long
myarr = Range("A8:C20").Value 'Or however you initialize your array.
indx = 1 'Or whichever row you would want to check.
With Application
Debug.Print Join(.Index(myarr, indx, 0), "") <> ""
End With
End Sub
Not sure if it will be faster than a loop though, since we call a worksheet application.
No, there isn't a faster way especially considering that arrays in VBA are stored column-wise in memory. The values on a single row are not stored adjacent in memory as it's the case with column values - you could easily test this by running a For Each loop on an array.
That being said, you should probably consider having a Function that checks if a specific row is empty so that you can call it repeatedly and maybe also check for null strings if needed. For example a range of formulas returning "" will not be empty but you might want to have the ability to consider them empty.
For example, you could use something like this:
Public Function Is2DArrayRowEmpty(ByRef arr As Variant _
, ByVal rowIndex As Long _
, Optional ByVal ignoreEmptyStrings As Boolean = False _
) As Boolean
Const methodName As String = "Is2DArrayRowEmpty"
'
If GetArrayDimsCount(arr) <> 2 Then
Err.Raise 5, methodName, "Array is not two-dimensional"
ElseIf rowIndex < LBound(arr, 1) Or rowIndex > UBound(arr, 1) Then
Err.Raise 5, methodName, "Row Index out of bounds"
End If
'
Dim j As Long
Dim v As Variant
'
For j = LBound(arr, 2) To UBound(arr, 2)
v = arr(rowIndex, j)
Select Case VBA.VarType(v)
Case VbVarType.vbEmpty
'Continue to next element
Case VbVarType.vbString
If Not ignoreEmptyStrings Then Exit Function
If LenB(v) > 0 Then Exit Function
Case Else
Exit Function
End Select
Next j
'
Is2DArrayRowEmpty = True 'If code reached this line then row is Empty
End Function
Public Function GetArrayDimsCount(ByRef arr As Variant) As Long
If Not IsArray(arr) Then Exit Function
'
Const MAX_DIMENSION As Long = 60
Dim dimension As Long
Dim tempBound As Long
'
'A zero-length array has 1 dimension! Ex. Array() returns (0 to -1)
On Error GoTo FinalDimension
For dimension = 1 To MAX_DIMENSION
tempBound = LBound(arr, dimension)
Next dimension
Exit Function
FinalDimension:
GetArrayDimsCount = dimension - 1
End Function
Notice that I haven't checked for IsObject as your values are coming from a range in Excel but you would normally check for that in a general case.
Your pseudocode IsEmpty(myarr(1,*)) could be translated to:
Is2DArrayRowEmpty(myarr, 1, False) 'Empty strings would not be considered Empty
or
Is2DArrayRowEmpty(myarr, 1, True) 'Empty strings would be considered Empty

Problem working with variant data type w/vba

I am trying to learn to use variant data type but facing issues.
Public Function z_score(sections As Range, marks As Range) As Variant
Dim n As Integer
Dim score() As Variant 'marks range has a few empty cells and error cells as well
'hence using variant data type
n = UBound(sections.Value)
ReDim score(1 To n, 1 To 2)
score = marks.Value 'assigning marks range values to first column of score
For i = 1 To n 'adding second column with integer index for calling later
score(i, 2) = i
Next i
z_score = score
End Function
I am getting value error instead of nx2 matrix as output.
Can you please help how to resolve the error.
Any help is much appreciated, thanks..
There are a few areas that could cause this code to fail, I'm afraid:
If the passed in range is only 1 cell, the assignment to an array will throw an error.
VBA doesn't have a method for copying or cloning arrays, so your code score = marks.Value isn't doing what your comments are saying,
The sections parameter doesn't appear to be doing anything. You are sizing the array against it, but then iterating the marks array to assign values.
I'm not sure what you want to do with the function, but if it is a UDF called from a worksheet, it would need to be a formula array.
You could adjust your code as follows to have something a little more robust:
Public Function z_score(marks As Range) As Variant
Dim scoreArray() As Variant, marksArray() As Variant
Dim i As Long
marksArray = RangeValueToArray(marks)
ReDim scoreArray(1 To UBound(marksArray, 1), 1 To 2)
For i = 1 To UBound(marksArray, 1)
scoreArray(i, 1) = i
scoreArray(i, 2) = marksArray(i, 1)
Next
z_score = scoreArray
End Function
Private Function RangeValueToArray(rng As Range) As Variant
Dim v() As Variant
If rng.Cells.Count = 1 Then
ReDim v(1 To 1, 1 To 1)
v(1, 1) = rng.Value2
RangeValueToArray = v
Exit Function
End If
v = rng.Value2
RangeValueToArray = v
End Function
I think I figured out the problem. Assigning values of range to array works but makes the assigned array two dimensional array but with only 1 column if given range has only one column or row! So moving the redim with preserve to after assignment line worked for my purpose.
But if one wants to assign values to a column other than first in a 2D array (albeit with 1 column), only solution I am aware of at this point is to do iteration the way Ambie suggested.
Public Function z_score(sections As Range, marks As Range) As Variant
Dim score() As Variant 'marks range has a few empty cells and error cells as well
'hence using variant data type
Dim n As Integer
n = UBound(sections.Value)
score = marks.Value 'assigning marks range values to first column of score
ReDim Preserve score(1 To n, 1 To 2)
For i = 1 To n 'adding second column with integer index for calling later
score(i, 2) = i
Next i
z_score = score
End Function

Filtering out Numbers from Array

So I have an Array called TagOptions - it contains numeric values according to a pervious if statement. In order to take out values I didn't want I gave the undesired values a place holder value of 0. I am now trying to filter out this value but can't find anything online that is helpful.
Will paste the entire function for context but more interested in just filtering out the placeholder zeros from my array.
Sorry if this is novice but I am very new to this:
Private Sub CommandButton4_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("TEST")
lrow = sh.Cells(Rows.count, 1).End(xlUp).Row
Dim splitstring As String
Dim holder As String
Dim myarray() As String
Dim strArrayNumber() As Integer
Dim strArrayTag() As String
Dim TagOptions() As Integer
Dim TagOptions2() As Integer
ReDim strArrayNumber(1 To lrow) As Integer
ReDim strArrayTag(1 To lrow) As String
'Initial for loop splitting tags and removing any tags with text (MV-4005A)
'Transfering those remaining tag numbers into array if they match equip selected
For a = 1 To lrow
If sh.Cells(a, 1).Value <> vbNullString Then
splitstring = sh.Cells(a, 1).Value
myarray = Split(splitstring, "-")
strArrayTag(a) = myarray(0)
End If
If IsNumeric(myarray(1)) = False Then
myarray(1) = 0
End If
If strArrayTag(a) = TagNumber1.Value Then 'Only stored if has selected Equipment tag
strArrayNumber(a) = myarray(1)
End If
Next a
'Sort Created Array
Quicksort strArrayNumber, LBound(strArrayNumber), UBound(strArrayNumber)
ReDim TagOptions(1000 To 2000) As Integer
Dim j As Integer
For j = 1000 To 2000
For b = 1 To UBound(strArrayNumber)
If strArrayNumber(b) = j Then
TagOptions(j) = 0
Exit For
Else
TagOptions(j) = j
End If
Next b
sh.Cells(j, 8) = TagOptions(j)
Next j
Quicksort TagOptions, LBound(TagOptions), UBound(TagOptions)
For f = LBound(TagOptions) To UBound(TagOptions)
sh.Cells(f, 9) = TagOptions(f)
Next f
**TagOptions2 = Filter(TagOptions, "0", False, vbDatabaseCompare)**
Me.ComboBox1.List = TagOptions
End Sub
Thnak you in advance for any help.
tl;dr entire code, just note that VBA's Filter() function applied on a "flat" 1-dim array only executes a partial character search finding "0" also in strings like e.g. "10" or "205", what definitely isn't what you want to do :-;
Btw, if your initial array is a 2-dim array, there are number of answers at SO how to slice data from a 2-dim array and transpose or double transpose them to a 1-dim array needed as starting point.
Solving the actual core question how to filter out zero-digits
To succeed in filtering out zeros in a 1-dim array, simply use the following function via the Worksheetfunction FilterXML (available since vers. 2013+):
tagOptions = WorksheetFunction.FilterXML("<t><s>" & _
Join(tagOptions, "</s><s>") & "</s></t>", _
"//s[not(.='0')]")
resulting in a 1-based 2-dim array.
If you prefer, however to get a resulting 1-dim array instead, simply transpose it via tagOptions = Application.Transpose(tagOptions) or tagOptions = WorkSheetFunction.Transpose(tagOptions).
You can find an excellent overview at Extract substrings ... from FilterXML

Add Strings to Dynamic Array VBA

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.

Resources