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
Related
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 !
In a loop, I want to check if value is in an array and if so, then skip to the next iteration.
My low understanding of Arrays are blocking me though:
I am using the function below (from: Check if a value is in an array or not with Excel VBA) to see check whether the value is in the array.
Public Function IsInArray(Vtobefound As Long, arr As Variant) As Boolean
Dim i
For i = LBound(arr) To UBound(arr)
If arr(i) = Vtobefound Then
IsInArray = True
Exit Function
End If
Next i
IsInArray = False
End Function
But my Sub below still doesn't work:
Sub CountCellstest()
Dim i, k As Long
' Dim iArray() As Single
ReDim iArray(1 To 1) As Single
For i = 1 To 3
If IsInArray(i, iArray) Then 'ERROR HERE on the i
GoTo next_iteration
End If
ReDim aArray(1 To 1) As Single
iArray(UBound(iArray)) = 2
ReDim Preserve iArray(1 To UBound(iArray) + 1) As Single
'DO smth
MsgBox "test"
next_iteration:
Next i
End Sub
The error comes from the line:
If IsInArray(i, iArray) Then
I get Compile error: ByRef arugment type mismatch
The function IsInArray needs a long and I put a long in the formula so I don't understand the issue... Can someone explain?
Common mistake. Your i variable is actually a Variant hence the mismatch. You have to type all the variables individually like this:
Dim i As Long, k As Long
I have function that returns me list of current sheets:
Function getListOfSheetsW() As Variant
Dim i As Integer
Dim sheetNames() As Variant
ReDim sheetNames(1 To Sheets.Count)
For i = 1 To Sheets.Count
sheetNames(i) = Sheets(i).name
Next i
getListOfSheetsW = sheetNames
End Function
Then I have function which returns TRUE or FALSE depending on if needle is in haystack or not.
Function IsInArray2(ByVal needle As String, haystack() As String) As Boolean
Dim element As Variant
For Each element In haystack
If element = needle Then
IsInArray = True
Exit Function
End If
Next element
IsInArray = False
End Function
My goal is to create new subroutine which will first check if sheet with given name already exist and if not then create new one. I've tried following:
Sub CreateNewSheet(ByVal dstWSheetName As String)
Dim srcWSheetName As String
' Dim sheetNames() As String
Dim sheetNames() As Variant
sheetNames = getListOfSheetsW()
Dim sheetCount As Integer
If IsInArray2(dstWSheetName, sheetNames) Then
MsgBox "Sheet with following name: " & dstWSheetName & " already exists"
Else
srcWSheetName = ActiveSheet.name
sheetCount = Sheets.Count
' CREATE NEW SHEET
' Worksheets(dstWsheetName).Delete
Sheets.Add.name = dstWSheetName
' Q: why 6 instead of 5
' Worksheets("Test").Move after:=Worksheets("Sheet5")
Worksheets(dstWSheetName).Move After:=Worksheets(sheetCount + 1)
' SWITCH TO SRC SHEET
Worksheets(srcWSheetName).Activate
End If
End Sub
I'm calling it this way:
Sub CallCreateNewSheet()
Call CreateNewSheet("test")
End Sub
I guess the problem is with Dim sheetNames() As String or Dim sheetNames() As Variant.
When I use Dim sheetNames() As String I get
Run-time error '13': Type mismatch
When I use Dim sheetNames() As Variant I get:
Compile error: Type mismatch: array or user-defined type expected
I had similar problem before but defining sheetNames as array did not helped here. What is the problem and what does the two different errors mean?
You will avoid all these problems if you switch from typed arrays to variant-arrays.
In your first function, delete this line:
Dim sheetNames() As Variant
Change the definition line of your 2nd function from this:
Function IsInArray2(ByVal needle As String, haystack() As String) As Boolean
...to this:
Function IsInArray2(ByVal needle As String, haystack) As Boolean
In your sub, change this line:
Dim sheetNames() As Variant
...to this:
Dim sheetNames
How about a new script like:
Sub NewSheetByName(SName as String)
Dim oldSheet as Object
For Each oldSheed in ThisWorkbook.Sheets
if oldSheet.Name = Sname Then
MsgBox "Sheet with following name: " & SName & " already exists"
Exit Sub
End If
Next
oldSheet = ActiveSheet
Sheets.Add.Name = SName
ActiveSheet.Move , Worksheets(Sheets.Count)
oldSheet.Activate
End Sub
The variables has to be in sinc.
Declare the variable sheetNames in the same manner in both procedures:
Sub CreateNewSheet(ByVal dstWSheetName As String) and
Function getListOfSheetsW() As Variant
declare it as : Dim sheetNames() As String
Also note that the Function IsInArray2 always returns False.
To correct this replace IsInArray with IsInArray2 in the body of the function.
It's a good practice to always have the
Option Explicit
at the beginning of the modules.
However it'll save all the trouble to validate the existence of a worksheet, just to assign the target worksheet to a variable, it will give an error and the variable return nothing if the worksheet in not present. Try this:
Dim Wsh As Worksheet
On Error Resume Next
Set Wsh = Workbook(x).Worksheets("Test")
On Error GoTo 0
If Wsh Is Nothing Then Add Worksheet
I wish to use an Excel array function to generate an array of strings and then pass this to a user defined function to strip blanks and concatenate the strings separated by a ",".
I have a function that does this when called from a VBA macro. When I try to use it as a user defined function, e.g. =ConcStr({"A","B","C"}), I get a #Value! error.
Function is below:
Sub StrTest()
Dim StaticArray(1 To 3) As String
Dim Result As String
StaticArray(1) = "A"
StaticArray(2) = "B"
StaticArray(3) = "C"
Result = ConcStr(Arr:=StaticArray)
MsgBox Result
End Sub
Function ConcStr(Arr() As String) As String
MsgBox "started"
Dim N As Long
Dim Total As String
For N = LBound(Arr) To UBound(Arr)
MsgBox Arr(N)
Total = Total & "," & Arr(N)
Next N
ConcStr = Total
End Function
If you rewrite your UDF to accept a Variant instead, it should work. Also, you can just use the Join function to accomplish what you need:
Function ConcStr(arr As Variant) As String
ConcStr = Join(arr, ",")
End Function
Declare, dim, assign and pass the array over as a variant.
Sub StrTest()
Dim StaticArray As Variant, Result As String
ReDim StaticArray(1 To 3)
StaticArray(1) = "A"
StaticArray(2) = "B"
StaticArray(3) = "C"
Result = ConcStr(Arr:=StaticArray)
MsgBox Result
Result = ConcStr2(Arr:=StaticArray)
MsgBox Result
End Sub
Function ConcStr(Arr As Variant) As String
MsgBox "started"
Dim N As Long, Total As String
For N = LBound(Arr) To UBound(Arr)
MsgBox Arr(N)
Total = Total & "," & Arr(N)
Next N
ConcStr = Mid(Total, 2) 'Mid to get rid of the first comma
End Function
Function ConcStr2(Arr As Variant) As String
'could just be like this,
ConcStr2 = Join(Arr, ",")
End Function
I've added an alternative Join Function version to simplfy things and modified your function with the Mid function to remove the leading comma.
I was able to get what you want with:
Public Function ConcatString(ByVal arr As Variant) As String
ConcatString = vbNullString
Dim i As Long, n As Long, z as Long
z = LBound(arr) : n = UBound(arr)
For i = z To n
ConcatString = ConcatString + arr(i)
Next i
End Function
I have a great function that I use all of the time for a 1 dimensional Excel VBA array that checks if a string is in an array:
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr(), stringToBeFound)) > -1)
End Function
Unfortunately it does not work when using it to check for a 2 dimensional array, like I have here:
Sub new_idea_filter()
home_sheet = ActiveSheet.Name
c = 1
Dim myfilters(1 To 4, 1 To 5000)
myfilters(1, 4) = "Test"
If IsInArray("Test", myfilters()) = True Then
killer = True
End If
End Sub
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr(), stringToBeFound)) > -1)
End Function
It keeps erroring out in the function saying subscript out of range, anyone have a thought how I can check if a string is in the 2 dimensional array?
Something from my code collection
You can use Application.Match. This will work for both 1D and 2D array :)
See this
Sub Sample()
Dim myfilters(1 To 4, 1 To 5000)
myfilters(1, 4) = "Test"
If IsInArray("Test", myfilters()) = True Then MsgBox "Found"
End Sub
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
Dim bDimen As Byte, i As Long
On Error Resume Next
If IsError(UBound(arr, 2)) Then bDimen = 1 Else bDimen = 2
On Error GoTo 0
Select Case bDimen
Case 1
On Error Resume Next
IsInArray = Application.Match(stringToBeFound, arr, 0)
On Error GoTo 0
Case 2
For i = 1 To UBound(arr, 2)
On Error Resume Next
IsInArray = Application.Match(stringToBeFound, Application.Index(arr, , i), 0)
On Error GoTo 0
If IsInArray = True Then Exit For
Next
End Select
End Function
As long as you're in Excel (or have a reference to it), you can use the Index function to slice your array into rows or columns.
Public Function IsInArray(ByVal vToFind As Variant, vArr As Variant) As Boolean
Dim i As Long
Dim bReturn As Boolean
Dim vLine As Variant
For i = LBound(vArr, 1) To UBound(vArr, 1)
vLine = Application.WorksheetFunction.Index(vArr, i) 'slice off one line
If IsArray(vLine) Then 'if it's an array, use the filter
bReturn = UBound(Filter(vLine, vToFind)) > -1
Else 'if it's not an array, it was 1d so check the value
bReturn = vLine = vToFind
End If
If bReturn Then Exit For 'stop looking if one found
Next i
IsInArray = bReturn
End Function
Public Sub test()
Dim arr() As Variant
ReDim arr(1 To 2, 1 To 2)
arr(1, 2) = "Test"
Debug.Assert IsInArray("Test", arr)
arr(1, 2) = "Wrong"
Debug.Assert Not IsInArray("Test", arr)
ReDim arr(1 To 3)
arr(2) = "Test"
Debug.Assert IsInArray("Test", arr)
arr(2) = "Wrong"
Debug.Assert Not IsInArray("Test", arr)
Debug.Print "Passed"
End Sub
If you get the data from a recordset i use this method; first i use GetString for the recordset, second use Split to convert the string in a array unidimensional where each item is a string with all the information. After that you con use the function IsInArray.
The code is:
RecSet.Open strSQL, Cn
RecSet.MoveFirst
RecString = RecSet.GetString(, , ";", vbCr) 'genera una cadena con los datos. Campos separados por ; y registros por vbCR
RecSplit = Split(RecString, vbCr) 'Genera un array unidimensional con la cadena
you can test the code, but remember only works if you get the data from a recordset
You can try converting your original Function to be able to work with arrays. Please try the following, though note that I have not tested if it works.
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
Dim cell As Variant
For Each cell In arr
IsInArray = IsInArray Or (UBound(Filter(cell(), stringToBeFound)) > -1)
Next
End Function
Regards
#Siddharth-Rout answer above is working perfectly with Application.Match in addition to the Filter function :-). - My solution tries to use the OP Filter function only: As the filter function needs a 1dim array, the array is splitted into portions.
A) Alternative solution using the original FILTER function instead of Match plus error handling
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
Dim i As Long
If nDim(arr) = 1 Then
IsInArray = (UBound(Filter(arr(), stringToBeFound)) > -1)
Else ' allows using filter function in portions
For i = 1 To UBound(arr, 2)
If (UBound(Filter(Application.Transpose(Application.Index(arr, 0, i)), stringToBeFound)) > -1) Then IsInArray = True: Exit For
Next i
End If
End Function
Helper function to get array Dimension
Function nDim(ByVal vArray As Variant) As Long
' Purp: get number of array dimensions
' Site: http://support.microsoft.com/kb/152288
Dim dimnum As Long
Dim ErrorCheck As Variant
On Error GoTo FinalDimension
For dimnum = 1 To 60000
ErrorCheck = LBound(vArray, dimnum)
Next
FinalDimension:
nDim = dimnum - 1
End Function
B) Recursive solution using the original FILTER function instead of Match plus error handling
Function IsInArray(stringToBeFound As String, arr As Variant, Optional i As Long = 0) As Boolean
Select Case i
Case -1: ' stop 2dim calls
Case 0: IsInArray = IsInArray(stringToBeFound, arr, nDim(arr)) ' start recursive call
Case 1: IsInArray = (UBound(Filter(arr(), stringToBeFound)) > -1) ' 1dim array
Case Else ' allows using filter function in portions
If (UBound(Filter(Application.Transpose(Application.Index(arr, 0, i)), stringToBeFound)) > -1) Then
IsInArray = True
Else ' recursive calls (2dim array)
IsInArray = IsInArray(stringToBeFound, arr, IIf(i + 1 > UBound(arr), -1, i + 1))
End If
End Select
End Function
I have an Excel users version solution for this as well.
Cant you just split concatenate the array into a single column (1-d array)? you got x columns. who cares about the # of rows for now.
I would do : col 1 & "/// unique character delimiter"& col#1 & col 2 & "/// unique character delimiter"& col#2 & col 3 & "/// unique character delimiter"& col#2 & ... & & col (n-1) & "/// unique character delimiter"& col#(n-1) & & "/// unique character delimiter"& col#n
turning the 2-d array into a 1-d array.
and index match this joined-up array/column, to find the multiple occurances of the string located in the original array.
And whats good about this, because of the unique way you joined it (any unique delimator charavter + col# ) it can and will also tell you the original column each found return value of the string your looking for resided in. SO you dont loose any information.
(you can do that implementing =match ("/"&string&"/")) the position of the looked-for text in the lookup output and the next occurrence of the special unique delimiter & the next (subsequent) col # that's to the right of it.
Doesn't this do the same thing , as the macros above or the question asks for ?
and in an (almost) non-macro*/non-vba way?
*see below for why it can be done with out without macros.
So in the end, you can just turn any 2-d N.M array into an 1-d X array, while keeping all the information (of which column the text was originally belonging to) and still do a simple lookup, index-match or a LoopALL function (which is great) :
Lookupall macro to use to find and return multiple found occurrences of string:
Function LookupAll(vVal, rTable As Range, ColumnI As Long) As Variant
Dim rFound As Range, lLoop As Long
Dim strResults As String
With rTable.Columns(1)
Set rFound = .Cells(1, 1)
For lLoop = 1 To WorksheetFunction.CountIf(.Cells, vVal)
Set rFound = .Find(what:=vVal, After:=rFound, LookIn:=xlFormulas, lookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
strResults = strResults & "," & rFound(1, ColumnI)
Next lLoop
End With
LookupAll = Trim(Right(strResults, Len(strResults) - 1))
End Function
Up to you whether you use VBA lookup all function above or an index-match formula in excel which can find and return multiple occurrences of a search find.
Delimation and join of separate columns of an array strips a need for an array search (which I've never been able to do as I wanted - ie. get the results all into 1 cell), and turns it into a single and simpler 1-d array without any information loss.
I believe the speed would be as fast (and accurate) as anything else. Particularly as you've reduced/condensed the array into a single array - 1 column.
Any thoughts?