This question already has an answer here:
Search for an element in the VBA ArrayList
(1 answer)
Closed 2 years ago.
I was trying to delete the specific element in the array vba when certain condition are true but i end up getting error 424. May I know the right way to do it? I tired to use redim, however it doesn't suit my condition as after the comparing with others array i need to store the data back into excel file where the location in the excel file is already sorted.
Before changing the remarkRange to array variant, I used it as Dim remarkRange
As Range where I can just use .Clear to clear the range item in a specific element.
I tried remarkRange(I, 1)=" " it runs without error but im not sure if its suitable. May I know the correct way to do it? Thanks.
Dim remarkRange() As Variant
remarkRange= wb.Sheets("wb").Range("A1:A5").Value2
For I = LBound(remarkRange) To UBound(remarkRange)
If (some condition is true) then
remarkRange(I, 1).Delete
End If
Next I
I expected the element in the specific cell in the array to be empty, but I got error 424
An array doesn't have a Delete method. It's also misleading to have the Range in remarkRange when it's an array, not a Range. Maybe a different name, e.g. remarks or whatever is clear to you.
If you're going to write the array back to the worksheet, then I see no problem changing an element to a blank string.
For i = LBound(remarks, 1) To UBound(remarks, 1)
If some condition Then
remarks(i, 1) = ""
End If
Next i
It seems you'll need to decide what you mean by 'delete'. I'm not aware of a Delete property of an array of variants so while your code might compile it would throw an object required error.
However, your point about previously using the Clear method on a Range object, suggests that you just want to read your range values into an array, remove the contents if certain conditions aren't me, and then re-write your array to the range. If that's the case, you probably wouldn't want to resize your array as the rows or columns wouldn't line up - more commonly, you'd set the item of your variant array to Empty.
The code below shows how to do this in a simple routine of taking 10 numbers from column A, removing all odd numbers and re-writing the numbers to Column C - but with the rows still matching:
Public Sub EmptyItemsAndKeepArraySize()
Dim inArr() As Variant
Dim i As Long
'Read range into arrays.
inArr = Sheet1.Range("A1:A10").Value2
'Clear all numbers that are not even.
For i = 1 To UBound(inArr, 1)
If inArr(i, 1) Mod 2 <> 0 Then inArr(i, 1) = Empty
Next
'Write cleared array to column C
Sheet1.Range("c1").Resize(UBound(inArr, 1)).Value = inArr
End Sub
If, however, you really do want to remove and resize your array, then a simple way of doing it is to populate a temporary collection first, resizing an output array and then populating that with the collection items. In the example below the code removes all odd numbers and then writes the array to column B - but as an array reduced in size (ie contiguous rows):
Public Sub DeleteItemsAndShrinkArray()
Dim inArr() As Variant, outArr() As Variant
Dim i As Long
Dim temp As Collection
Dim v As Variant
'Read range into arrays.
inArr = Sheet1.Range("A1:A10").Value2
'Keep all even numbers in a temporary collection.
Set temp = New Collection
For i = 1 To UBound(inArr, 1)
If inArr(i, 1) Mod 2 = 0 Then temp.Add inArr(i, 1)
Next
'Dimension the output array.
ReDim outArr(1 To temp.Count, 1 To 1)
'Populate new array from temp collection.
i = 1
For Each v In temp
outArr(i, 1) = v
i = i + 1
Next
'Write reduced array to column B
Sheet1.Range("B1").Resize(UBound(outArr, 1)).Value = outArr
End Sub
Related
I have a column of data with unique strings where the first 4 characters in the string may be a repeat of the first 4 characters in another string, in a format similar to:
ABCDEF
ABCDXY
ABCDKL
DTYTZF
DTYTSD
I am attempting to loop through this data to identify which 4 starting characters appear more then three times. If the first 4 digits of the string occur 3 times or more, I would like to remove these from the array entirely, and end up with an array that excludes these values. For example, in my column above, as 3 strings or more begin with 'ABCD', I would like to remove all strings that begin with this code, and have only every other value remain, such that my result would be:
DTYTZF
DTYTSD
I am currently looping through the array, pushing any value that occurs three times or more into a NEW array, and plan to then use that list to do a second pass on the original array, and remove any matches. This may not be the most efficient way, but I've not been able to determine a better way that is guaranteed not to mess my data up.
I have worked through looping through the strings to identify which strings occur more then once, but when I try to push them to an array, the string successfully is pushed to the array, but is then replaced with the next value as soon as it is pushed to the array. I know the value is pushed correctly, because if I view the array immediately afterwards, I see the value in the array. When the next value is pushed and you view the array again, only the new value is displayed (The older ones are not).
I believe this is due to my limited understanding of ReDim-ing arrays, and me not fully understanding a code snippet for pushing this value into an array. My (condensed) code is as follows:
Sub pickupValues()
Dim valuesArray()
Dim i As Long
Dim y As Long
Dim sizeCheck As Long
Dim tempArray() As String
valuesArray() = Worksheets("Sheet1").Range("A1:A10").Value
For i = LBound(valuesArray) To UBound(valuesArray)
sizeCheck = 0
For y = LBound(valuesArray) To UBound(valuesArray)
If Left(valuesArray(i, 1), 4) = Left(valuesArray(y, 1), 4) Then
sizeCheck = sizeCheck + 1
i = y
If sizeCheck >= 3 Then
ReDim tempArray(1 To 1) As String 'I'm not sure why I need to do this.
tempArray(UBound(tempArray)) = Left(valuesArray(i, 1), 4) 'I believe this is what pushes the value into the array.
ReDim Preserve tempArray(1 To UBound(tempArray) + 1) As String 'Again unsure on what the purpose of this is.
viewArray (tempArray)
End If
End If
Next y
Next i
End Sub
Function viewArray(myArray)
Dim txt As String
Dim i As Long
For i = LBound(myArray) To UBound(myArray)
txt = txt + myArray(i) + vbCrLf
Next i
MsgBox txt
End Function
What am I doing wrong?
I would like to re-use the same basic code later in the function to push other values OUT of an array based on if they match the string or not, but it seems VBA does not like to move values out of arrays either. Is there an easy solution that would match both scenarios?
I've rewritten what you are trying to do. I'm using the filter function to quickly get your results in the array
Option Explicit
Public Sub pickupValues()
Dim tmp As Variant
Dim results As Variant
Dim i As Long
Dim v
' Make sure this matches your range
With ThisWorkbook.Sheets("Sheet1")
' Important to transpose the input here as Filter will only take a 1D array. Even though it's only 1 column, setting an array this way will generate a 2D array
tmp = Application.Transpose(.Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)).Value2)
End With
' ReDiming to the maximum value and slimming down afterwards is much quicker then increasing your array each time you've found a new value
ReDim results(1 To UBound(tmp))
For Each v In tmp
' Less then 2 as first result is '0'. Will return '-1' if can't be found but as test criteria is in the array it will always be at least 0
If UBound(Filter(tmp, Left(v, 4))) < 2 Then
i = i + 1
results(i) = v
End If
Next v
' Redim Preserve down to actual array size
If i > 0 Then
ReDim Preserve results(1 To i)
viewArray (results)
Else
MsgBox "Nothing Found"
End If
End Sub
' Should really be a sub as doesn't return anything back to caller
Public Sub viewArray(myArray)
MsgBox Join(myArray, vbCrLf)
End Sub
Your algorithm is not helping you.
Option 1:
Sort your array. Then you can make a single pass to find sequential values with the same first four characters and count them.
Option 2:
Use a Dictionary object: first four characters as key, number of occurrences as value.
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.
Okay so a bit of context to this one. I have some code that sorts through a list of locations of parts, to create a dropdown list locations that can be selected and will be used elsewhere for sorting later on. The location is a 9 digit code and I am trying to use VLookup to find the corresponding name to its location code from a different sheet, Combining them into an array and then displays that array in a combo box.
I am currently getting a "Subscript out of range" error on the line containing the VLookup.
Locan2(i, 1) = Application.VLookup(Locan(i), Sheet16.Range("A2:D700"), 2, False)
I have included below the whole subroutine for context, any help would be appreciated this is annoying me greatly and I can't find anything similar from my searches.
Private Sub Compbox() '<============Populates Location Drop down list==============>
Dim lastrow As Long
Dim Locn As String
Dim Locan() As String
Dim Locan2() As String
Dim Location As Collection
lastrow = Sheet5.Cells(Sheet5.Rows.Count, "J").End(xlUp).Row 'Find length of Sheet5
Set Location = New Collection
For i = 4 To lastrow
Locn = Sheet5.Cells(i, 10).Value
On Error Resume Next
Location.Add (Locn), CStr(Locn) 'Add location values, ignore duplicates
On Error GoTo 0
Next i
i = 0
QuickSort Location, 1, Location.Count 'Sort into ascending order
CollectionToArray Location, Locan 'Turn into an array
ReDim Locan2(UBound(Locan), 2)
For i = 0 To UBound(Locan)
Locan2(i, 0) = Locan(i)
Locan2(i, 1) = Application.VLookup(Locan(i), Sheet16.Range("A2:D700"), 2, False)
Next i
'Find the corresponding location name and create a 2D array
With Me.ComboBox2
.ColumnCount = 2
.BoundColumn = 1 'display combo box
.ColumnWidths = "1 in; 3in"
.List = Locan
End With
End Sub
Thanks for your help in advance!
Perhaps there is some flaw in your logic in these steps:
QuickSort Location, 1, Location.Count
CollectionToArray Location, Locan 'Turn into an array
ReDim Locan2(UBound(Locan), 2)
Potentially an off-by-one error or maybe no allocated arr is being returned?
I notice you are using custom VBA functions to sort the collection and transform to Array.
Why not use built-in ArrayList object?
Dim Location As mscorlib.ArrayList
Dim Locan As Variant
Set Location = New mscorlib.ArrayList
For i = 4 To lastrow
Locn = Sheet5.Cells(i, 10).Value
On Error Resume Next
Location.Add CStr(Locn) 'ArrayList has the add function too!
On Error GoTo 0
Next i
Location.Sort 'Has the sort function built-in too!
Locan = Location.toArray 'And the toArray function is built-in too!!
That may assist you if you are doing standard quicksort and stand toArray functionality.
I left the full Object declaration so you can see you need to add a reference to the mscorlib.dll
You're getting the error because you're going past the last index of Locan2, I would put a breakpoint in on that line and take a look at the value of i. Difficult to say more without having the whole sheet in front of me.
I'm working with arrays and I'm sorry but I'm a bit new to it and still confused. I have already this code to store the values in a range in an array and if I run it, it is empty.
attPresent = ws.Range("H4:H" & lastrow)
ReDim attPresent(1 To UBound(attPresent))
For k = LBound(attPresent) To UBound(attPresent)
MsgBox attPresent(k)
Next
Can someone please tell me where I'm wrong? I've read any other posts and gather some ideas, but still not working.
You can go like this
Dim attPresent as Variant
attPresent = ws.Range("H4:H" & lastrow).Value '<-- this will automatically size the array to a 2dimensional array of as many rows as the range ones and one column
For k = LBound(attPresent,1) To UBound(attPresent,1)
MsgBox attPresent(k,1)
Next
Or
Dim attPresent as Variant
attPresent=Application.Transpose(Range("H4:H" & lastrow).Value) '<-- this will automatically size the array to a 1dimensional array of as many elements as the range
For k = LBound(attPresent) To UBound(attPresent)
MsgBox attPresent(k)
Next
Reference MSDN: ReDim Statement (Visual Basic)
When you Redim the array you are erasing all the values. Use ReDim Preserve to resize the last dimension of the Array and still preserve the values of the array.
After the dynamic array has been allocated(the first time Redim is used) you can only resize the last dimension of a array and you cannot change the number of dimensions. In your code you are trying to convert a 2 Dimensional array to a 1 Dimensional array, you can not do that.
You should watch this complete series: Excel VBA Introduction. This is the relevant video: Excel VBA Introduction Part 25 - Arrays
'Try this code example to suit your case
Sub StoreRangeofCellsToAnArray()
'presumes optionbase=0
'presume Range("a1:c3") contain number 1 to 9
Dim MyRange, MyArray(9), n
n = 0
For Each c In Range("a1:c3")
MyArray(n) = c
n = n + 1
Next
'testing: reprint array
For n = 0 To 8
Debug.Print MyArray(n)
Next
End Sub
I am not entirely sure why I am getting the error message of
Expecting a dynamic array var
with this code:
Option Explicit
Sub ArrayTest()
Dim i As Integer, BankList(0) As Variant, x As Integer
For i = 0 To UBound(ScreenArray)
If ScreenArray(i) Like "TR=SUB*" Then
Debug.Print ScreenArray(i)
ReDim Preserve BankList(x) '<<< ERROR LINE
BankList(x) = ScreenArray(i)
x = x + 1 'Raise the value for the next occurrence, if needed.
End If
Next
End Sub
Basically I am attempting to move specific strings from one array to a new array, if certain criteria are met. It's difficult to determine how many strings will be in the new array until running this For...Next statement.
If you can't tell from the code, the original array is ScreenArray and the new array is BankList.
To create a dynamic array, do not specify the size in the original declaration.
So use BankList() As Variant instead of BankList(0) As Variant.