Compare Cell value with Array content - arrays

My goal is to check in one column if each cell contains (besides other values) a letter from my array.
The cells look something like "123A".
My array contains values A, C, D, X, Y, Z.
Both just example values.
Note my if-statement should be true if the cell contains any of the letters, so for the example it should be true.
For the cell Value "123B" it should be false (no B in array).
I found a "IsinArray" Function that appears to be working but checks for specific values.
What I would need is closer to ---> "*" & IsinArray & "*"
The function I found looks like this:
Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
End Function
Also my For statement to loop through the column is working (I'd say ^^)
I am also open to "creative" solutions if you have any ideas how to do it better.

Try,
Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
Dim s As String, i As Integer
Dim a As Variant
For i = 1 To Len(stringToBeFound)
s = Mid(stringToBeFound, i, 1)
For Each a In arr
If s = a Then
IsInArray = True
Exit Function
End If
Next a
Next i
End Function

You could swop it around
Option Explicit
Public Sub Test()
Dim testArray(), cellValue As String, rng As Range
Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1") '<== contains
testArray = Array("A", "C", "D", "X", "Y", "Z")
Debug.Print IsInArrayValue(testArray, rng)
End Sub
Public Function IsInArrayValue(ByVal testArray As Variant, ByVal rng As Range) As Variant
Dim i As Long, testString As String
testString = rng.Text
If rng.Cells.Count > 1 Then
IsInArrayValue = CVErr(xlErrNA)
Exit Function
End If
For i = LBound(testArray) To UBound(testArray)
If InStr(testString, testArray(i)) > 0 Then
IsInArrayValue = True
Exit Function
End If
Next
IsInArrayValue = False
End Function
If using as an UDF you could either pass the array in as shown above or if array doesn't change you could move into the function itself. Personally, I prefer passing the array as an argument to the function as more flexible. I can't work out where your row to copy is coming from. Your comment posted as an answer uses a j variable that doesn't appear to be involved in the shown loop and the row is copied from another sheet. So below will not work directly but gives you a framework.
Public Function IsInArrayValue(ByVal rng As Range) As Variant
Dim i As Long, testString As String, testArray()
testArray = Array("A", "C", "D", "X", "Y", "Z")
testString = rng.Text
If rng.Cells.Count > 1 Then
IsInArrayValue CVErr(xlErrNA)
Exit Function
End If
For i = LBound(testArray) To UBound(testArray)
If InStr(testString, testArray(i)) > 0 Then
IsInArrayValue = True
Exit Function
End If
Next
IsInArrayValue = False
End Function
Call:
The comment below is looks like a new question but you probably want something like:
Dim loopRange As Range, rng As Range
With ThisWorkbook.Worksheets("Filter")
Set loopRange = .Range(.Cells(1, VarNutzerSpalte), .Cells(VarAnzahlZeilen, VarNutzerSpalte))
End With
For Each rng In loopRange
If IsInArrayValue(ArrAuswahlNutzer, rng) Then
rng.EntireRow.Copy '<= use Union to gather range if all being pasted in a block somewhere
End If
Next
A union version might looks like:
Dim loopRange As Range, rng As Range, unionRng As Range
With ThisWorkbook.Worksheets("Filter")
Set loopRange = .Range(.Cells(1, VarNutzerSpalte), .Cells(VarAnzahlZeilen, VarNutzerSpalte))
End With
For Each rng In loopRange
If IsInArrayValue(ArrAuswahlNutzer, rng) Then
If Not unionRng Is Nothing Then
Set unionRng = Union(unionRng, rng)
End If
Set unionRng = rng '<= use Union to gather range if all being pasted in a block somewhere
End If
Next
If Not unionRng Is Nothing Then
unionRng.EntireRow.Copy 'destination for paste
End If

Sorry to answer my own question (corrections/feedback to this solution is welcome of course)
I tried it like this and i guess it should work (cant really test because other parts of my makro arent working)
It is kinda unecessary complicated and maybe slow but id say it could work:
For i = 1 To VarAnzahlZeilen
Set rng = Worksheets("Filter").Range(Cells(i, VarNutzerSpalte), Cells(i, VarNutzerSpalte))
If IsInArrayValue(ArrAuswahlNutzer, rng) Then
Worksheets("Import").Rows(j).Copy
Worksheets("Filter").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If
Next i
Uses this function by QHarr (with only the array name changed)
Public Function IsInArrayValue(ByVal testArray As Variant, ByVal rng As Range) As Variant
Dim i As Long, testString As String
testString = rng.Text
If rng.Cells.Count > 1 Then
IsInArrayValue = CVErr(xlErrNA)
Exit Function
End If
For i = LBound(testArray) To UBound(testArray)
If InStr(testString, testArray(i)) > 0 Then
IsInArrayValue = True
Exit Function
End If
Next
IsInArrayValue = False
End Function
Thanks alot # QHarr and also # Dy.Lee !

Related

Error 9 displayed when using my own defined arrays in this code in VBA

I have 2 arrays taken from 2 ranges in a sheet. I'm trying to create a third array that contains only the values contained in array 1 that are missing in array 2 (I found this code online).
Array 2´s size will vary and depends on this code:
Dim iListaIncompleta() As Variant
Dim iCountLI As Long
Dim iElementLI As Long
iCountLI = Range("B1").End(xlDown).Row
ReDim iListaIncompleta(iCountLI)
For iElementLI = 1 To iCountLI
iListaIncompleta(iElementLI - 1) = Cells(iElementLI, 2).Value
Next iElementLI
and Array 1's size is always from A1:A7, and I use this code to create it:
Dim iListaCompleta() As Variant
Dim iElementLC As Long
iListaCompleta = Range("A1:A7")
This is the original code I found online to extract missing values:
Dim v1 As Variant, v2 As Variant, v3 As Variant
Dim coll As Collection
Dim i As Long
'Original Arrays from the code:
v1 = Array("Bob", "Alice", "Thor", "Anna") 'Complete list
v2 = Array("Bob", "Thor") 'Incomplete list
Set coll = New Collection
For i = LBound(v1) To UBound(v1)
If v1(i) <> 0 Then
coll.Add v1(i), v1(i) 'Does not add value if it's 0
End If
Next i
For i = LBound(v2) To UBound(v2)
On Error Resume Next
coll.Add v2(i), v2(i)
If Err.Number <> 0 Then
coll.Remove v2(i)
End If
If coll.Exists(v2(i)) Then
coll.Remove v2(i)
End If
On Error GoTo 0
Next i
ReDim v3(LBound(v1) To (coll.Count) - 1)
For i = LBound(v3) To UBound(v3)
v3(i) = coll(i + 1) 'Collections are 1-based
Debug.Print v3(i)
Next i
End Sub
However, this code has arrays defined like this:
v1 = Array("Bob", "Alice", "Thor", "Anna")
And the actual arrays I wanna use are defined differently (as you can see in the first two pieces of code). When I try to run the code with them, it displays
Error 9: Subscript out of range.
The code works well as it originally is, but when I try to use MY arrays, it's when I get this error.
Obviously, I've tried it changing the names of the variables (v1 and v2) to my own 2 arrays (iListaCompleta and iListaIncompleta), and still doesn't work.
Any ideas??
Thank you in advance!
Here's a function that can be used to compare arrays of any dimension size to pull out differences and put only the differences in a one-dimensional array:
Public Function ArrayDifference(ByVal arg_Array1 As Variant, ByVal arg_array2 As Variant) As Variant
If Not IsArray(arg_Array1) Or Not IsArray(arg_array2) Then Exit Function 'Arguments provided were not arrays
Dim vElement As Variant
Dim hDifference As Object: Set hDifference = CreateObject("Scripting.Dictionary")
For Each vElement In arg_Array1
If Not hDifference.exists(vElement) Then hDifference.Add vElement, vElement
Next vElement
For Each vElement In arg_array2
If hDifference.exists(vElement) Then
hDifference.Remove vElement
Else
hDifference.Add vElement, vElement
End If
Next vElement
ArrayDifference = hDifference.Keys
End Function
Here's how you would call the function to compare two different arrays. It also includes how to populate the initial arrays using your provided setup:
Sub arrays()
Dim ws As Worksheet: Set ws = ActiveWorkbook.ActiveSheet
Dim rList1 As Range: Set rList1 = ws.Range("A1", ws.Cells(ws.Rows.Count, "A").End(xlUp))
Dim rList2 As Range: Set rList2 = ws.Range("B1", ws.Cells(ws.Rows.Count, "B").End(xlUp))
Dim aList1 As Variant
If rList1.Cells.Count = 1 Then
ReDim aList1(1 To 1, 1 To 1)
aList1(1, 1) = rList1.Value
Else
aList1 = rList1.Value
End If
Dim aList2 As Variant
If rList2.Cells.Count = 1 Then
ReDim aList2(1 To 1, 1 To 1)
aList2(1, 1) = rList2.Value
Else
aList2 = rList2.Value
End If
Dim aList3 As Variant
aList3 = ArrayDifference(aList1, aList2)
MsgBox Join(aList3, Chr(10))
End Sub

VBA 1D array ("array or user defined type expected")

I need to make an array of numbers from "n" to "n2" to use it in an IF function like
If ArrayContainsItem([transpose(row(320:420))], WidthArray) Then
'Do stuff
End If
And I am wondering, how do you write that first array (which must be written inside that line directly and not dimensioned prior)? It returns an error "array or user-defined type expected"
I got it working with
dim arr() as variant
arr = [transpose(row(320:420))]
'Main function
If ArrayContainsItem(arr, WidthArray) Then
'Do stuff
End If
End Sub
But I need it to be made up directly inside the if function line like in the first code example.
The function I am using looks like (can't be altered in any way)
Function ArrayContainsItem(ArrayBig() As Variant, ArraySmall() As Variant) As Boolean
'Declare variables
Dim iOption As Long
'Set variables
ArrayContainsItem = False
'Main function
For iOption = 2 To UBound(ArraySmall)
For Each Item In ArrayBig
If CStr(Item) = ArraySmall(iOption) Then
ArrayContainsItem = True
End If
Next Item
ArrayContainsItem = False
Next iOption
End Function
Changing the function to
Function ArrayContainsItem(ArrayBig As Variant, ArraySmall() As Variant)
returns error 2015 on ArrayBig and item is empty.
Would, someone, please help me figure this one out?
Reproducable example
Sub ArrayTesting()
'Old variables
Dim WS_MS As Worksheet
Set WS_MS = ThisWorkbook.Worksheets("Machine Specification")
Dim LowerFilmWidthArray() As Variant
Dim CurrentParameter As Range
Dim ParametersColumn As Long
ParametersColumn = 2
Dim LastColumn As Long
LastColumn = 4
'Width
Set CurrentParameter = WS_MS.Cells.Find("Width", lookat:=xlWhole)
WidthArray = Application.Transpose(Application.Transpose(WS_MS.Range(Cells(CurrentParameter.Row, ParametersColumn), Cells(CurrentParameter.Row, LastColumn)).Value))
'Main function
If ArrayContainsItem([transpose(row320:420)], WidthArray) Then
End If
End Sub
Change your function declaration:
Function ArrayContainsItem(ArrayBig() As Variant, ArraySmall() As Variant) As Boolean
to
Function ArrayContainsItem(ArrayBig As Variant, ArraySmall() As Variant) As Boolean
Sample:
Sub foo()
Dim arraySmall(1 To 3) As Variant
arraySmall(1) = "foo"
arraySmall(2) = "bar"
arraySmall(3) = "baz"
Debug.Print ArrayContainsItem([transpose(row(320:420))], arraySmall) ' Returns False
arraySmall(1) = "1"
arraySmall(2) = "2"
arraySmall(3) = "420"
Debug.Print ArrayContainsItem([transpose(row(320:420))], arraySmall) ' Returns True
End Sub
Function ArrayContainsItem(ArrayBig As Variant, arraySmall() As Variant) As Boolean
'Declare variables
Dim iOption As Long
'Main function
For iOption = 2 To UBound(arraySmall)
Dim i As Long
For i = LBound(ArrayBig) To UBound(ArrayBig)
If CStr(ArrayBig(i)) = arraySmall(iOption) Then
ArrayContainsItem = True
Exit Function '<-- add this
End If
Next
Next iOption
End Function

VBA Convert array Type

In VBA, how do I convert An array from one type to another?, in my case i want to convert an array of type "String" to type "variant" because i have a function parameter that needs an array of that type.
here is an example code,
Sub test_highlighfind()
Dim Rng As Range: Set Rng = ThisDocument.Range.Paragraphs(6).Range
Dim arr() As String: arr = Split(Rng.Text)
Call highlightWordsUsingFind(arr, ThisDocument, 7)
End Sub
Sub highlightWordsUsingFind(ByRef arr() As Variant, ByRef doc As Document, _
Optional ByVal HighlightColor As Integer = 6)
Dim i As Long, SearchRange As Range
Set SearchRange = doc.Range
With SearchRange.Find
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Forward = True
.Wrap = wdFindContinue
.ClearFormatting
For i = LBound(arr) To UBound(arr)
.Text = arr(i)
.Execute 'Execute// Runs the find operation. Returns True if the find operation is successful
SearchRange.HighlightColorIndex = HighlightColor
Next
End With
End Sub
i know i can change the parameter type to "string" ByRef arr() As String but i have other functions that return an array of type "variant" and i need the output to the function above
Remove the parentheses in your declaration.
Sub highlightWordsUsingFind(ByRef arr As Variant, ...)
Then you can pass arr() directly. It will be wrapped into a Variant/Array that will refer to the original array (so no copying will happen).
Since you wrote the highlightWordsUsingFind sub, the easiest way is to change the parameter to Variant as already mentioned by GSerg. It might be a good idea to ensure the parameter is actually an array with the IsArray function. Here are some other conversion examples.
Another option is to create a new Variant array:
Function StringToVariantArray(ByRef arr() As String) As Variant()
Dim index As Integer
Dim result() As Variant
Redim result(LBound(arr) To UBound(arr))
For index = LBound(arr) To UBound(arr)
result(index) = arr(index)
Next
StringToVariantArray = result
End Function
Sub test_highlighfind()
Dim Rng As Range
Dim varr() As Variant
Set Rng = ThisDocument.Range.Paragraphs(6).Range
varr = StringToVariantArray(Split(Rng.Text))
Call highlightWordsUsingFind(varr, ThisDocument, 7)
End Sub

Array of arrays? in macro

I have a function Sub fRemoveCharList(ColArray As Variant, char As Variant) (code below) to remove a list of characters w.r.t a list of header names.
If I call it with...
Sub RemoveCharList()
fRemoveCharList Array("field1","field2","field3"), Array("]", "&", "%")
End Sub
...it works fine
But if I instead go...
Call fRemoveCharList(("field1","field2","field3"), ("]","&","%"))
...which is my preferred way, I get a "Type mismatch" error. Do I need to have an array of arrays to use it like this?
I have Googled how to proceed, but found nothing I could work with.
The function:
Sub fRemoveCharList(ColArray As Variant, char As Variant)
Dim x As Variant
Dim LR As Long, i As Long, j As Long
Dim Heading As Variant
Dim headingFound As Range
Dim lngColIndex As Long
For Each Heading In ColArray
On Error Resume Next
Set headingFound = Range("1:1").Find(What:=Heading, LookIn:=xlFormulas, LookAt:=xlPart)
Err.Clear: On Error GoTo 0: On Error GoTo -1
If Not headingFound Is Nothing Then lngColIndex = headingFound.Column
LR = Cells(Rows.Count, lngColIndex).End(xlUp).Row
For i = 1 To LR
With Cells(i, lngColIndex)
x = .Value
For j = LBound(char) To UBound(char)
x = Replace(x, char(j), vbNullString)
Next
.Value = x
End With
Next i
Next
End Sub
Try either of:
Run fRemoveCharList Array("field1","field2","field3"), Array("]", "&", "%")
Or:
Call fRemoveCharList(Array("field1","field2","field3"), Array("]","&","%"))

Excel for Mac 2011: UBound() Not Working

I'm working on making an existing macro-enabled spreadsheet functional on Excel for Mac 2011.
I have a function (Source) that searches arrays for a specified value:
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
It works perfectly in Excel 2013, but on Excel for Mac 2011, I receive the error:
Runtime error '9': Subscript out of range
I broke it apart and found that the UBound call is what's causing the error.
I'd like to change as little as possible for maintainability. How can I fix this error for the Mac version?
Thanks in advance for any replies!
Edit: #Siddharth Rout's solution is spot on, but since I was searching arrays within a loop, I had to modify the loop to reset the array between each iteration as follows (in case anyone else runs into the same issue!):
' --- START Reset Array for OS X ---
Dim OS_X_Hack(99) As String
For intIndex = 0 To 99
OS_X_Hack(intIndex) = Original(intIndex)
Next
Erase Original()
ReDim Original(0 To 99) As String
For intIndex = 0 To 99
Original(intIndex) = OS_X_Hack(intIndex)
Next
Erase OS_X_Hack()
' --- END Reset Array for OS X ---
Ok This is my observation. If you call the function once in a procedure then it will work fine. For Example
Sub Sample()
Dim a As Variant
Dim s As String
Dim strTemp As String
s = "CC"
strTemp = "A,B,C,D"
a = Split(strTemp, ",")
Debug.Print IsInArray(s, a)
End Sub
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
However if you call it twice in the procedure then you will get an error Runtime error '9': Subscript out of range. Maybe it is an Excel 2011 Bug?
Sub Sample()
Dim a As Variant
Dim s As String
Dim strTemp As String
s = "CC"
strTemp = "A,B,C,D"
a = Split(strTemp, ",")
Debug.Print IsInArray(s, a)
s = "A"
Debug.Print IsInArray(s, a)
End Sub
Solution
Recreate the array. See this example.
Sub Sample()
Dim a As Variant
Dim s As String
Dim strTemp As String
s = "CC"
strTemp = "A,B,C,D"
a = Split(strTemp, ",")
Debug.Print IsInArray(s, a)
s = "A"
a = Split(strTemp, ",")
Debug.Print IsInArray(s, a)
End Sub
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Credit for this solution goes to this answer by Brian Hinchey. Using the code below, I'm able to call IsInArray within a loop in Excel for Mac 2011.
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
End Function

Resources