I need to do a is nothing check on a Variant array to exclude empty indexes from being used. I use is nothing to capture empty indexes which hold (empty) objects, it works fine but for indexes that hold regular data types (not objects), it throws an exception.
Dim arrArray() as Variant
'... fill array with values but leave some indexes out
'Loop through the array
For i = LBound(arrArray) To UBound(arrArray)
'Check if the current array item is an empty object
If arrArray(i) Is Nothing Then
'don't debug.print
'Debug if it's not an empty object
Else
Debug.Print arrArray(i)
End If
Next
I could use on error resume next but since error handling is done dynamically it would change the error handling status so I would like to avoid that. If it can't be avoided please check my other question.
Note: Currently I just work with empty objects, at some point in the future I might get an actual object. So in the long run I will have to check if the index contains an existing object (otherwise - I presume - debug.print will throw an error).
Please, try the next function. It will return a cleaned array (without empty elements) for a wide range of elements type:
Function elimEmptyArrayElements(arrX As Variant) As Variant
Dim i As Long, arrNoEmpty, k As Long
ReDim arrNoEmpty(UBound(arrX)): k = 0
For i = LBound(arrX) To UBound(arrX)
If Not IsMissing(arrX(i)) Then
If Not IsObject(arrX(i)) Then
If TypeName(arrX(i)) = "String" Then
If arrX(i) <> "" Then
arrNoEmpty(k) = arrX(i): k = k + 1
End If
Else
If Not IsEmpty(arrX(i)) Then
arrNoEmpty(k) = arrX(i): k = k + 1
End If
End If
Else
Set arrNoEmpty(k) = arrX(i): k = k + 1
End If
End If
Next i
ReDim Preserve arrNoEmpty(k - 1)
elimEmptyArrayElements = arrNoEmpty
End Function
Please, test it using the next Sub. It will stop on each pair of initial/cleaned array representation. When possible, both arrays are joined in Immediate Window.
If not possible, only the number of their elements (Ubound(arr)) is returned. You may iterate between each array elements and see that no empty one exists:
Sub testElimEmptyArrayElements()
Dim arr
arr = Split("1,7,9,,10,5,6,,2,8,3,4", ",")
Debug.Print Join(arr, "|") 'just to visually see the initial array content
arr = elimEmptyArrayElements(arr)
Debug.Print Join(arr, "|"): Stop 'the cleaned array
arr = Application.Transpose(Range("A2:A20").value) 'a 1D array extracted from a column range
Debug.Print Join(arr, "|")
arr = elimEmptyArrayElements(arr)
Debug.Print Join(arr, "|"): Stop 'the cleaned array
arr = Array(1, 2, 3, , 4, , 5): Debug.Print "Initial number of numeric elements: " & UBound(arr)
arr = elimEmptyArrayElements(arr): Debug.Print "Cleaned array number of numeric elements: " & UBound(arr): Stop
arr = Array(Range("A2"), Range("A3"), , Range("A6")): Debug.Print "Initial number of Range Object elements: " & UBound(arr)
arr = elimEmptyArrayElements(arr): Debug.Print "Cleaned array number of Range elements: " & UBound(arr): Stop
arr = Array(ActiveSheet, , ActiveSheet.Next): Debug.Print "Initial number of Sheet Object elements: " & UBound(arr)
arr = elimEmptyArrayElements(arr): Debug.Print "Cleaned array number of Sheet Object elements: " & UBound(arr): Stop
arr = Array("my string", 100, Range("A2"), , ActiveSheet, , ThisWorkbook, "test", 6): Debug.Print "Initial number of variate elements: " & UBound(arr)
arr = elimEmptyArrayElements(arr): Debug.Print "Cleaned array number of variate types elements: " & UBound(arr)
Debug.Print arr(2).value 'the cell value
Debug.Print arr(3).name 'the activesheet name
Debug.Print arr(4).Sheets.count 'activeworkbook number of sheets
End Sub
You can simply check and filter your array for empty slots with if YourArray(i)<>"" then syntax
Beside that, I see some wrong declaration issues in first line of your code:
1-You can't use Array as a name for your array
2-You should use parentheses after you array name (e.g. Dim myArray() as variant)
3-Variable type can not have parentheses (As far as I know)
I recommend to declare your array like following:
dim arr()
This way it automatically considered as an array of variants. So my suggested code would be like this:
Dim arr()
'... fill array with values but leave some indexes out
For i = LBound(arr) To UBound(arr)
If arr(i)<>"" Then
'do nothing
Else
'do something
end if
Next i
Related
I have an array an VBA
strname=[English,science,Social,English,Social,science,science,Social,English,,,]
I want to remove duplicates and empty values in this array and concatenate them.
Expected Output : English;science;Social
I tried with looping logic but it doesnt work
For i=0 to 10
if strname[i] <> "" then
if strname[i]= strname[i+1] then
tempstr=strname[i]
end i
end if
next
here it will check 0 with 1 , 1 with 2 like that.Am trying for proper solution
Please, try the next way:
Sub removeArrDuplAndEmpty()
Dim x As String, arr, i As Long, dict As Object
x = "English,science,Social,English,Social,science,science,Social,English,,,"
Set dict = CreateObject("Scripting.Dictionary")
arr = Split(x, ",") 'extract the array
For i = 0 To UBound(arr)
If arr(i) <> "" Then dict(arr(i)) = 1 'create unique keys for non blank array elements
Next
arr = dict.keys 'place back the dictionary keys in the initial array
Debug.Print Join(arr, ";") 'only to visually see the result
End Sub
The next version processes the string as you show it in your question:
Sub removeArrDuplAndEmptyBis()
Dim x As String, arr, i As Long, dict As Object
x = "[English,science,Social,English,Social,science,science,Social,English,,,]"
Set dict = CreateObject("Scripting.Dictionary")
arr = Split(left(Mid(x, 2), Len(Mid(x, 2)) - 1), ",")
For i = 0 To UBound(arr)
If arr(i) <> "" Then dict(arr(i)) = 1
Next i
arr = dict.keys
Debug.Print Join(arr, ",")
End Sub
This is what you want?
If not, please show an example of your real string and how it must look after processing...
I have this code:
Array1 = Array("apple", "pear")
Array2 = Array("Dog", "Cat")
All_Arrays = Array(Array1, Array2)
For each item in All_Arrays
Debug.print item
Next item
I want to change it to print the variable names Array1 and Array2. Is this possible?
I'd use a Dictionary, keyed with the identifier names:
Dim Array1 As Variant
Array1 = Array("apple", "pear")
Dim Array2 As Variant
Array2 = Array("Dog", "Cat")
With New Scripting.Dictionary
.Add "Array1", Array1
.Add "Array2", Array2
Dim names As Variant
names = .Keys
Dim outer As Long
For outer = LBound(names) To UBound(names)
Dim k As String
k = names(outer)
Debug.Print k & ":"
Dim inner As Long
For inner = LBound(.Item(k)) To UBound(.Item(k))
Debug.Print vbTab & .Item(k)(inner)
Next
Next
End With
Output:
Array1:
apple
pear
Array2:
Dog
Cat
Yep, use nested arrays all the time...
For iArr = 0 to ubound(All_Arrays)
subArr = All_Arrays(iArr) '0 will be Array1, 1 will be Array2
'Then do whatever you want with subArr
next iArr
edit1: Oh, maybe you want the actual variable name? "Array_1" and "Array_2" as strings? That is not possible (to my knowledge) without explicitly handing back a string of the name. i.e.
All_Arrays_Names = Array("Array1", "Array2")
edit2: Maybe it is possible, but its certainly not trivial: Print a variable's name
An Array of Arrays aka Jagged Array
Option Explicit
Sub testJaggedArray()
Dim Array1 As Variant: Array1 = Array("apple", "pear")
Dim Array2 As Variant: Array2 = Array("Dog", "Cat")
Dim All_Arrays As Variant: All_Arrays = Array(Array1, Array2)
Dim i As Long
Dim k As Long
For i = LBound(All_Arrays) To UBound(All_Arrays)
For k = LBound(All_Arrays(i)) To UBound(All_Arrays(i))
Debug.Print All_Arrays(i)(k)
Next k
Next i
End Sub
Result in the Immediate Window (CTRL+G)
apple
pear
Dog
Cat
To get the same result you could alternatively do:
For i = LBound(All_Arrays) To UBound(All_Arrays)
Debug.Print Join(All_Arrays(i), vbLf)
Next i
Very basic alternative using a jagged array
An array is no object disposing of something like a .Name property, but you might build an array of arrays, aka as jagged array defining your own names therein.
The idea is to use a jagged array's first element(row) as container for the array names, whereas only the succeeding elements contain the relevant arrays. Instead of #MathieuGuindon 's valid dictionary approach, the names can be read in directly from the jagged array (e.g. via a help function Header() here).
Note that the array names in this example are referred to as ordinal numbers (1-based).
The following code intends to demonstrate an alternative approach giving a basic starting idea and could be changed individually covering more sophisticated needs. This might include error handling, accepting other array bases and functions as well as developping additional class methods or properties.
Sub testJagged()
Dim jagged: ReDim jagged(2)
jagged(0) = Array("Array1", "Array2")
jagged(1) = Array("Apple", "Pear")
jagged(2) = Array("Dog", "Cat")
Dim i As Long
For i = LBound(jagged) + 1 To UBound(jagged)
Debug.Print header(jagged, i) & ":"
Debug.Print vbTab & Join(jagged(i), vbNewLine & vbTab)
Next
'how to refer to array names and selected elements
Dim NamedElem
For Each NamedElem In jagged(0)
Debug.Print "all Elems of " & NamedElem & ": " & _
Join(getNamedArray(jagged, NamedElem), ",")
Debug.Print "1st Elem of " & NamedElem & ": " & _
getNamedArray(jagged, NamedElem)(0)
Next
End Sub
Help function Header()
Function header(arr, ByVal OrdinalHeaderNum As Long)
'Note: assumes zero-based headers in jagged array
header = arr(LBound(arr))(OrdinalHeaderNum - 1)
End Function
Help function getNamedArray()
Function getNamedArray(arr, ByVal ArrName As String)
Dim num As Variant
num = Application.Match(ArrName, arr(LBound(arr)), 0)
If IsNumeric(num) Then getNamedArray = arr(num)
End Function
Output in VB Editor's immediate window:
Array1:
Apple
Pear
Array2:
Dog
Cat
all Elems of Array1: Apple Pear
1st Elem of Array1: Apple
all Elems of Array2: Dog Cat
1st Elem of Array2: Dog
I have an array like this
dim arr(1 to 5) as string
arr(1)="a"
arr(3)="b"
arr(5) = "c"
(arr(2),arr(4) are empty).
How can I redim this arr(1to5) to exclude empty values and save also values "a","b","c" (I want the output like arr(1to3), arr(1)="a", arr(2)="b", arr(3)="c")?
In general I do not know how many of them will be empty, so I need some general code for this (not for this specific example).
I was thinking about new temporary array to save all nonempty values and then redim arr(1to5).
Maybe it is a better (quick) way to do it?
I wrote sth similar:
Sub test()
Dim myArray() As String
Dim i As Long
Dim y As Long
ReDim Preserve myArray(3)
myArray(1) = "a"
myArray(3) = "c"
Dim myArray2() As String
y = 1
For i = LBound(myArray) To UBound(myArray)
If myArray(i) <> "" Then
ReDim Preserve myArray2(y)
myArray2(y) = myArray(i)
y = y + 1
End If
Next i
ReDim myArray(UBound(myArray2))
myArray = myArray2
End Sub
However I would like to avoid creating new array.
create a new array of the same size. Loop the first array and insert the values when not empty into the new array keeping track of the last spot with value in the new array, then redim preserve the new array to only the size that has values.
Sub kjlkj()
Dim arr(1 To 5) As String
arr(1) = "a"
arr(3) = "b"
arr(5) = "c"
Dim newArr() As String
ReDim newArr(1 To UBound(arr))
Dim j As Long
j = LBound(newArr)
Dim i As Long
For i = LBound(arr) To UBound(arr)
If arr(i) <> "" Then
newArr(j) = arr(i)
j = j + 1
End If
Next i
ReDim Preserve newArr(LBound(newArr) To j - 1)
'do what you want with the new array.
End Sub
Alternative via Filter() function
"However I would like to avoid creating new array."
A negative filtering allows a basically simple alternative, however you have to
declare your array dynamically (i.e. without preset number of elements) to allow a rebuild overwriting the original array,
execute a double replacement over the joined array elements to allow insertion of a unique character that can be filtered out.
Sub testFilter()
Dim arr() As String
ReDim arr(1 To 5)
arr(1) = "a"
arr(3) = "b"
arr(5) = "c"
'Debug.Print Join(arr, ",") ' ~~> a,,b,,c
'rearrange arr via RemoveEmpty()
arr = RemoveEmpty(arr) ' >> function RemoveEmpty()
Debug.Print Join(arr, ",") ' ~~> a,b,c
End Sub
Help function RemoveEmpty()
Adding an unused unique character, e.g. $, to the empty elements plus eventual negative filtering allows to remove these marked elements.
Note that the double replacement is necessary to allow to mark consecutive empty elements by the $ mark, as VBA would skip additional characters here.
Function RemoveEmpty(arr)
Dim tmp
tmp = Replace(Replace(Join(arr, "|"), "||", "|$|"), "||", "|$|")
RemoveEmpty = Filter(Split(tmp, "|"), "$", False)
End Function
For i = 1 To max
matchFoundIndex = Application.Match(arr(i), arr, 0)
Next
The above code returns the first occurrence of arr(i) in arr. However, there can be other instances of arr(i) in arr. In short, how can I efficiently find such next instances of arr(i) in arr (avoiding the classic n^2 loop)?
you could "hide" every match found and keep using Application.Match():
Function GetIndexes(arr As Variant) As String
Dim tempArr As Variant, matchIndex As Variant, element As Variant
Dim matchIndexes As String
tempArr = arr ' use a temporary array not to spoil the passed one
For Each element In tempArr
If element <> "|||" Then 'skip elements already marked as "already found"
matchIndexes = ""
matchIndex = Application.Match(element, tempArr, 0) 'search for array element matching current one
Do
matchIndexes = matchIndexes & matchIndex & " "
tempArr(matchIndex - 1) = "|||" 'mark found array element as "already found"
matchIndex = Application.Match(element, tempArr, 0) 'search for next array element matching current one
Loop While Not IsError(matchIndex) ' loop until no occurrences of current array element
GetIndexes = GetIndexes & "element '" & element & "' found at indexes: " & Replace(Trim(matchIndexes), " ", ",") & vbCrLf
End If
Next
End Function
which you could exploit as follows:
Sub main()
Dim i As Long
Dim arr As Variant
arr = Array("a1", "a2", "a3", "a1", "a2", "a3")
MsgBox GetIndexes(arr)
End Sub
Is there an easy (one-liner) to search for a string within an array in VBA? Or will I need to loop through each element and compare it with the target string?
EDIT:
It is a one-dimensional array. I only need to know IF a string is somewhere in the array.
IE:
names(JOHN, BOB, JAMES, PHLLIP)
How do I find out if "JOHN" is in the array, it needs to be minimal as it will be repeated around 5000 times and I don't want the function to slow the overall process down.
If you want to know if the string is found in the array at all, try this function:
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
As SeanC points out, this must be a 1-D array.
Example:
Sub Test()
Dim arr As Variant
arr = Split("abc,def,ghi,jkl", ",")
Debug.Print IsInArray("ghi", arr)
End Sub
(Below code updated based on comment from HansUp)
If you want the index of the matching element in the array, try this:
Function IsInArray(stringToBeFound As String, arr As Variant) As Long
Dim i As Long
' default return value if value not found in array
IsInArray = -1
For i = LBound(arr) To UBound(arr)
If StrComp(stringToBeFound, arr(i), vbTextCompare) = 0 Then
IsInArray = i
Exit For
End If
Next i
End Function
This also assumes a 1-D array. Keep in mind LBound and UBound are zero-based so an index of 2 means the third element, not the second.
Example:
Sub Test()
Dim arr As Variant
arr = Split("abc,def,ghi,jkl", ",")
Debug.Print (IsInArray("ghi", arr) > -1)
End Sub
If you have a specific example in mind, please update your question with it, otherwise example code might not apply to your situation.
Another option would be use a dictionary instead of an array:
Dim oNames As Object
Set oNames = CreateObject("Scripting.Dictionary")
'You could if need be create this automatically from an existing Array
'The 1 is just a dummy value, we just want the names as keys
oNames.Add "JOHN", 1
oNames.Add "BOB", 1
oNames.Add "JAMES", 1
oNames.Add "PHILIP", 1
As this would then get you a one-liner of
oNames.Exists("JOHN")
The advantage a dictionary provides is exact matching over partial matching from Filter. Say if you have the original list of names in an Array, but were looking for "JO" or "PHIL" who were actually two new people in addition to the four we started with. In this case, Filter(oNAMES, "JO") will match "JOHN" which may not be desired. With a dictionary, it won't.
Another option that enforces exact matching (i.e. no partial matching) would be:
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
End Function
You can read more about the Match method and its arguments at
http://msdn.microsoft.com/en-us/library/office/ff835873(v=office.15).aspx
there is a function that will return an array of all the strings found.
Filter(sourcearray, match[, include[, compare]])
The sourcearray has to be 1 dimensional
The function will return all strings in the array that have the match string in them
Here's another answer. It works fast, reliably (see atomicules' answer) and has compact calling code:
' Returns true if item is in the array; false otherwise.
Function IsInArray(ar, item$) As Boolean
Dim delimiter$, list$
' Chr(7) is the ASCII 'Bell' Character.
' It was chosen for being unlikely to be found in a normal array.
delimiter = Chr(7)
' Create a list string containing all the items in the array separated by the delimiter.
list = delimiter & Join(ar, delimiter) & delimiter
IsInArray = InStr(list, delimiter & item & delimiter) > 0
End Function
Sample usage:
Sub test()
Debug.Print "Is 'A' in the list?", IsInArray(Split("A,B", ","), "A")
End Sub
more simple Function whichs works on Apple OS too:
Function isInArray(ByVal stringToBeFound As String, ByVal arr As Variant) As Boolean
Dim element
For Each element In arr
If element = stringToBeFound Then
isInArray = True
Exit Function
End If
Next element
End Function
This is my code, inspired by #atomicules
Public Function IsName(name As String) As Boolean
Dim names As Object
Set names = CreateObject("System.Collections.ArrayList")
names.Add "JOHN"
names.Add "BOB"
names.Add "JAMES"
names.Add "PHLLIP"
IsName = names.Contains(name)
End Function
And this is usage:
If IsName("JOHN") Then ...
You could use the following without the wrapper function, but it provides a nicer API:
Function IsInArray(ByVal findString as String, ByVal arrayToSearch as Variant) as Boolean
IsInArray = UBound(Filter(arrayToSearch,findString)) >= 0
End Function
The Filter function has the following signature:
Filter(sourceArray, stringToMatch, [Include As Boolean = True], [Compare as VbCompareMethod = vbBinaryCompare])
If it's a list of constants then you can use Select Case as follows:
Dim Item$: Item = "A"
Select Case Item
Case "A", "B", "C"
' If 'Item' is in the list then do something.
Case Else
' Otherwise do something else.
End Select
Completing remark to Jimmy Pena's accepted answer
As SeanC points out, this must be a 1-D array.
The following example call demonstrates that the IsInArray() function cannot be called only for 1-dim arrays,
but also for "flat" 2-dim arrays:
Sub TestIsInArray()
Const SearchItem As String = "ghi"
Debug.Print "SearchItem = '" & SearchItem & "'"
'----
'a) Test 1-dim array
Dim Arr As Variant
Arr = Split("abc,def,ghi,jkl", ",")
Debug.Print "a) 1-dim array " & vbNewLine & " " & Join(Arr, "|") & " ~~> " & IsInArray(SearchItem, Arr)
'----
'//quick tool to create a 2-dim 1-based array
Dim v As Variant, vals As Variant
v = Array(Array("abc", "def", "dummy", "jkl", 5), _
Array("mno", "pqr", "stu", "ghi", "vwx"))
v = Application.Index(v, 0, 0) ' create 2-dim array (2 rows, 5 cols)
'b) Test "flat" 2-dim arrays
Debug.Print "b) ""flat"" 2-dim arrays "
Dim i As Long
For i = LBound(v) To UBound(v)
'slice "flat" 2-dim arrays of one row each
vals = Application.Index(v, i, 0)
'check for findings
Debug.Print Format(i, " 0"), Join(vals, "|") & " ~~> " & IsInArray(SearchItem, vals)
Next i
End Sub
Function IsInArray(stringToBeFound As String, Arr As Variant) As Boolean
'Site: https://stackoverflow.com/questions/10951687/how-to-search-for-string-in-an-array/10952705
'Note: needs a "flat" array, not necessarily a 1-dimensioned array
IsInArray = (UBound(Filter(Arr, stringToBeFound)) > -1)
End Function
Results in VB Editor's immediate window
SearchItem = 'ghi'
a) 1-dim array
abc|def|ghi|jkl ~~> True
b) "flat" 2-dim arrays
1 abc|def|dummy|jkl|5 False
2 mno|pqr|stu|ghi|vwx True
A Case statement might suit some applications more simply:
select case var
case "a string", "another string", sVar
'do something
case else
'do something else
end select