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 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
Is there a way to remove the first element of an array in VBA?
Something like javascript shift() method?
Option Explicit
Sub Macro1()
There is no direct method in VBA but you can remove the first element easily like this:
'Your existing code
'...
'Remove "ReDim Preserve matriz(1 To UBound(matriz))"
For i = 1 To UBound(matriz)
matriz(i - 1) = matriz(i)
Next i
ReDim Preserve matriz(UBound(matriz) - 1)
There is unfortunately not. You have to write a method to do it. One good example is http://www.vbforums.com/showthread.php?562928-Remove-Item-from-an-array
'~~> Remove an item from an array, then resize the array
Public Sub DeleteArrayItem(ItemArray As Variant, ByVal ItemElement As Long)
Dim i As Long
If Not IsArray(ItemArray) Then
Err.Raise 13, , "Type Mismatch"
Exit Sub
End If
If ItemElement < LBound(ItemArray) Or ItemElement > UBound(ItemArray) Then
Err.Raise 9, , "Subscript out of Range"
Exit Sub
End If
For i = ItemElement To lTop - 1
ItemArray(i) = ItemArray(i + 1)
Next
On Error GoTo ErrorHandler:
ReDim Preserve ItemArray(LBound(ItemArray) To UBound(ItemArray) - 1)
Exit Sub
ErrorHandler:
'~~> An error will occur if array is fixed
Err.Raise Err.Number, , _
"Array not resizable."
End Sub
If you have a string array, you could join, offset, and split again.
Public Sub test()
Dim vaSplit As Variant
Dim sTemp As String
Const sDEL As String = "||"
vaSplit = Split("1 2 3 4", Space(1))
sTemp = Join(vaSplit, sDEL)
vaSplit = Split(Mid$(sTemp, InStr(1, sTemp, sDEL) + Len(sDEL), Len(sTemp)), sDEL)
Debug.Print Join(vaSplit, vbNewLine)
End Sub
Returns
2
3
4
Not an answer but a study on array addressing.
This code:
ReDim Preserve matriz(1)
matriz(1) = 5
Creates an array with two elements: 0 and 1
UBound() returns 1
Here is some code that may help explore the issue:
Option Explicit
Sub Macro1()
Dim matriz() As Variant
Dim x As Variant
Dim i As Integer
matriz = Array(0)
ReDim Preserve matriz(1)
matriz(1) = 5
ReDim Preserve matriz(2)
matriz(2) = 10
ReDim Preserve matriz(3)
matriz(3) = 4
Debug.Print "Initial For Each"
For Each x In matriz
Debug.Print ":" & x
Next x
Debug.Print "Initial For i = 0"
For i = 0 To UBound(matriz)
Debug.Print ":" & matriz(i)
Next i
Debug.Print "Initial For i = 1"
For i = 1 To UBound(matriz)
Debug.Print ":" & matriz(i)
Next i
Debug.Print "remove one"
For i = 1 To UBound(matriz)
matriz(i - 1) = matriz(i)
Next i
ReDim Preserve matriz(UBound(matriz) - 1)
For Each x In matriz
Debug.Print ":" & x
Next x
Debug.Print "remove one more"
For i = 1 To UBound(matriz)
matriz(i - 1) = matriz(i)
Next i
ReDim Preserve matriz(UBound(matriz) - 1)
For Each x In matriz
Debug.Print ":" & x
Next x
End Sub
Out:
Initial For Each
:0
:5
:10
:4
Initial For i = 0
:0
:5
:10
:4
Initial For i = 1
:5
:10
:4
remove one
:5
:10
:4
remove one more
:10
:4
No direct method, but sort of work around without loops :-)
This approach uses an intermediate target range to
[1] receive the array data (starting e.g. in cell A10) and
.... get them back as resized 2-dim datafield (counting from cell A11 thus omitting the first element) and
[2] transpose it back to a flat 1-dim array
Example code
Option Explicit
Sub Macro1()
'Method: use temporary target range to restructure array
Dim matriz() As Variant
Dim rng As Range
'[0.1] Assign same data set to array as in original post
matriz = Array(0, 5, 10, 4)
Debug.Print "a) original matriz(" & LBound(matriz) & " To " & UBound(matriz) & ")", Join(matriz, ", ")
'instead of:
' ReDim Preserve matriz(0 To 3)
' matriz(0) = 0: matriz(1) = 5: matriz(2) = 10: matriz(3) = 4
'[0.2] Set temporary range to memory
Set rng = ThisWorkbook.Worksheets("Tabelle1").Range("A10").Resize(UBound(matriz) + 1, 1)
'[1] Write array data to range and reassign to matriz cutting first row
rng = Application.Transpose(matriz) ' fill in array data (transposed to column)
matriz = rng.Offset(1, 0).Resize(UBound(matriz), 1) ' assign data to (2-dim) array omitting first row
'[2] Transpose back to flat 1-dim array
matriz = Application.Transpose(Application.Index(matriz, 0, 1))
Debug.Print "b) ~~> new matriz(" & LBound(matriz) & " To " & UBound(matriz) & ")", Join(matriz, ", "),
End Sub
Example output in VBE's immediate window (Debug.Print)
a) original matriz(0 To 3) 0, 5, 10, 4
b) ~~> new matriz(1 To 3) 5, 10, 4
//Edit #1 Tricky alternative using combobox properties & methods
Sub RemoveFirstElement()
'a) Assign same data set to array as in original post
Dim matriz() As Variant
matriz = Array(0, 5, 10, 4)
Debug.Print "a) original matriz (" & LBound(matriz) & " To " & UBound(matriz) & ")", Join(matriz, ", ")
'b) Remove first element in matriz (note 0-based indices!)
RemoveElem matriz, 0 ' << call help procedure RemoveElem
Debug.Print "b) ~~> new matriz (" & LBound(matriz) & " To " & UBound(matriz) & ")", Join(matriz, ", ")
End Sub
Help procedure RemoveElem
This help procedure profits from the integrated method .RemoveItem of a combobox control which you can get on the fly without need to create an extra userform *)
Sub RemoveElem(arr, ByVal elemIndex As Long)
'Use combobox properties and methods on the fly (without need to create form)
With CreateObject("Forms.ComboBox.1")
'a) assign existing values
.List = Application.Transpose(arr)
'b) delete e.g. 1st element (0-based control indices!)
.RemoveItem elemIndex
'c) assign modified values to tmp array (losing 2nd dimension by transposition)
Dim tmp As Variant
tmp = Application.Transpose(.List)
'd) decrement base by 1 (from 1 to 0) - optional
ReDim Preserve tmp(0 To UBound(tmp) - 1)
'e) overwrite original array
arr = tmp
End With
End Sub
Example output in VBE's immediate window (Debug.Print)
a) original matriz(0 To 3) 0, 5, 10, 4
b) ~~> new matriz(1 To 3) 5, 10, 4
Related links
Can I return a 0-based array from ws.UsedRange?
*) I found the way to create a solo combobox at Create an empty 2d-array )
What follows is a function "Shift", which behaves like the shift method in JS, and an example of the use of "Shift"
Sub tryShift()
Dim aRy As Variant, sT As Variant
aRy = Array("one", "two", "three", "four")
Debug.Print "Original array:"
For Each sT In aRy
Debug.Print sT
Next
aRy = Shift(aRy)
Debug.Print vbCrLf & "Array having been " & Chr(34) & "shifted" & Chr(34) & ":"
For Each sT In aRy
Debug.Print sT
Next
End Sub
Function Shift(aRy As Variant)
Dim iCt As Integer, iUbd As Integer
iCt = 0
iUbd = UBound(aRy)
Do While iCt < iUbd
aRy(iCt) = aRy(iCt + 1)
iCt = iCt + 1
Loop
ReDim Preserve aRy(UBound(aRy) - 1)
Shift = aRy
End Function
Output:
Original array:
one
two
three
four
Array having been "shifted":
two
three
four
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
If I declare a dynamic sized array like this
Dim myArray()
Then how I can get in the code if this array is empty or it contains elements?
I tried with IsArray(myArray) function that give me always True,
otherwise if I try with UBound(myArray) function, I get an error.
Any ideas? thanks in advance,
Max
After declaring the array, you have to initialize it:
Dim myArray()
ReDim myArray(-1)
Then such code will always work:
If UBound(myArray)<0 Then
'array is empty....
Else
'array not empty....
End If
Edit: as you can't initialize the array, here is longer way to check if it's empty or not:
Dim x, myCount
myCount = 0
If IsArray(myArray) Then
For Each x In myArray
myCount = myCount + 1
Next
End If
If myCount=0 Then
'array is empty....
Else
'array not empty....
End If
First some notes.
Using Dim A() is not so practical in VBScript, better use ReDim
A(n).
For example ReDim A(-1) is also empty array (no elements) but initialized.
And as the best way coders to talk is by examples...
Dim a(), b(0), c
c = Array(a, b)
ReDim d(-1)
WScript.Echo "Testing HasBound:"
WScript.Echo "a = " & HasBound(a) & ",", _
"b = " & HasBound(b) & ",", _
"c = " & HasBound(c) & ",", _
"d = " & HasBound(d)
WScript.Echo "Testing HasItems:"
WScript.Echo "a = " & HasItems(a) & ",", _
"b = " & HasItems(b) & ",", _
"c = " & HasItems(c) & ",", _
"d = " & HasItems(d)
'> Testing HasBound:
'> a = False, b = True, c = True, d = True
'> Testing HasItems:
'> a = False, b = True, c = True, d = False
Function HasBound(anyArray)
On Error Resume Next
HasBound = UBound(anyArray)
HasBound = (0 = Err)
On Error Goto 0
End Function
Function HasItems(anyArray)
For Each HasItems In anyArray
HasItems = 1
Exit For
Next
HasItems = (HasItems > 0)
End Function
As you see, 2 functions with different purpose. The difference is visible on array d which "has-boundary" but "has-not-items".
I found a solution, I wrote a specific function to check if an array is null or not; the function doesn't check if it has elements inside but only if the array is declared as dynamic without dimensions and no elements.
Dim dynamic_array() 'array without a dimension
Dim empty_array(0) 'array with a dimension but without an element inside
Dim full_array(0) : full_array(0) = "max" 'array with a dimension and with an element inside
Function IsNullArray(input_array)
On Error Resume Next
Dim is_null : is_null = UBound(input_array)
If Err.Number = 0 Then
is_null = False
Else
is_null = True
End If
IsNullArray = is_null
End Function
If IsNullArray(dynamic_array) Then
Response.Write("<p>dynamic array not 'ReDimed'</p>")
End If
If Not IsNullArray(empty_array) Then
Response.Write("<p>" & UBound(empty_array) & "</p>") 'return the last index of the array
End If
If Not IsNullArray(full_array) Then
Response.Write("<p>" & full_array(UBound(full_array)) & "</p>") 'return the value of the last element of the array
End If
The one thing I can think of right now is:
On Error resume next
if UBound(myArray) < 0 then response.write "Empty array" end if
EDIT: Max's comment
I've always checked for UBound = 0 and the first element is empty too:
If UBound(myArray) = 0 Then
if myArray(0) = "" then ''Depending on the type of the array
''array is empty....
End If
End If