Help Looping through array

[SouthernStan]

Hello,

I am trying to learn arrays and how to loop through and manipulate them and I am struggling greatly with this particular issue. I am sure its simple stuff but I just can get it to work.


To start I am simply placing a range of cells into a variant array.

Then I am trying to loop through the array and check each items value to see if it matches a string... again should be super simple... but I keep getting a "Run-time error 9: Subscript out of Range" error.

Here is my simple code:



Sub test()


Dim ar1 As Variant
Dim ST
Dim i


ar1 = Range("A1", Range("A1").End(xlDown)).Value
ST = "*[[]*"


For i = LBound(ar1) To UBound(ar1)
If ar1(i) = ST Then
MsgBox ("yes")
Else
MsgBox ("no")
End If

Next i


End Sub



If I could ever get past this part I was going to see if I could either delete the rows that don't match or copy the ones that do to another array...

[SamT]

To start I am simply placing a range of cells into a variant array.That makes a 2D array. Use

For i = LBound(ar1) To UBound(ar1)
If ar1(i, 1) = ST Then

Or, to make a 1D array, Use

ar1 = Application.Transpose(Range("A1", Range("A1").End(xlDown)).Value)
For i = LBound(ar1) To UBound(ar1)
If ar1(i) = ST Then

See: http://www.snb-vba.eu/VBA_Arrays_en.html for much more help

[SouthernStan]

Thank you very much. That Link is very helpful.

[SouthernStan]

Next Question:

I have read that you cannot delete rows from an 2d array. So I thought why not create another array that copies only the items you want into another array?

I am not sure how to make this work..

I have tried this:

Public Sub test()

Dim ar1 As Variant
Dim ar2 As Variant
Dim ST As String
Dim i As Integer


ar1 = Range("A1", Range("A1").End(xlDown)).Value
ST = "*[[]*"


For i = LBound(ar1) To UBound(ar1)
If ar1(i, 1) Like ST Then
ar2(i, 1) = ar1(1, 1)
End If

Next i


End Sub

This gives me a type mismatch error.

I have also tried:

For i = LBound(ar1) To UBound(ar1)
If ar1(i, 1) Like ST Then
ar2 = ar1
End If

This works but obviously it just copies the whole array not the matching item.

[SamT]

This gives me a type mismatch error.:dunno: Maybe because ar2 is not yet an array
Maybe this would work

Public Sub test()

Dim ar1 As Variant
Dim ar2 As Variant
Dim ST As String
Dim i As Long, j as long

Redim Ar1(1) '<---Redim to force it into an array
ar1 = Range("A1", Range("A1").End(xlDown)).Value
ST = "*[[]*"

For i = LBound(ar1) To UBound(ar1)
If ar1(i, 1) Like ST Then

ar2(Ubound(ar2)) = ar1(1, 1)
Redim Preserve ar2*UBpund(ar2) + 1)
End If

Next i
End Sub

Alternately, maybe

Public Sub test()

Dim ar1 As Variant
Dim ar2(1 to 1) 'As String 'You can set the type of values it can hold
Dim ST As String
Dim i As Long

ar1 = Range("A1", Range("A1").End(xlDown)).Value
ST = "*[[]*"

For i = LBound(ar1) To UBound(ar1)
If ar1(i, 1) Like ST Then

ar2(Ubound(ar2)) = ar1(1, 1)
Redim Preserve ar2*UBpund(ar2) + 1)
End If

Next i
End Sub

[Paul_Hossler]

The easiest (and probably cleanest) was to 'delete' a row from an array IMHO would be to

1. Flag the 'deleted' row somehow, maybe A(x,1) = Chr(0)

2. Add a test for Chr(0) before you use the row to see if it's still there

[SouthernStan]

Thanks for both of your replies

Using Sams Suggestion, I finally got it to work with one wrinkle.

First here is the code that works:

Public Sub test()

Dim ar1() As Variant
Dim ar2() As Variant
Dim ST As String
Dim i As Integer


ReDim ar2(1)


ar1 = Range("A1", Range("A1").End(xlDown)).Value
ST = "*[[]*"


For i = LBound(ar1) To UBound(ar1)
If ar1(i, 1) Like ST Then
ar2(UBound(ar2)) = ar1(1, 1)
ReDim Preserve ar2(UBound(ar2) + 1)
End If

Next i






End Sub

The one wrinkle i See is that the firs record (0) and last record in ar2 are empty.

[SamT]

ar2(UBound(ar2)) = ar1(1, 1)
Maybe ar1(1, 1) is empty

Try

ar2(UBound(ar2)) = ar1(i, 1)

[SouthernStan]

Sam,

That suggestion work but still leaves and empty row at the top and bottom of the array.

[SamT]

What does adding this line to the code in you post do

For i = LBound(ar1) To UBound(ar1)
MsgBox "i is " & i & "And ar1 i,1 = " & ar1(i, 1) '<---

[Paul_Hossler]

I think you're using incompatible starting indices (LBound) for the arrays, and having the ReDIm in the wrong place, and had a 1 instead of an i in the assignment

ar2 started at (0), but you started putting in values from ar1(1) leaving ar2(0) empty

Then you did a final ReDim ar2 which gave you an empty last ar2 empty


I added some comments to test() and fiddled with the logic in test2()




Option Explicit

Public Sub test()
Dim ar1() As Variant
Dim ar2() As Variant
Dim ST As String
Dim i As Integer ' better to use Long


ReDim ar2(1)
'ar2 start at (0) and goes to (1)

ar1 = Range("A1", Range("A1").End(xlDown)).Value
'ar1 starts at 1 to 11 and 1 to 1 (11 rows, 1 col in my test)

ST = "*[[]*"


For i = LBound(ar1) To UBound(ar1)
If ar1(i, 1) Like ST Then
ar2(UBound(ar2)) = ar1(I, 1) ' this was ar1 (one, one)
ReDim Preserve ar2(UBound(ar2) + 1)
End If

Next i
'ar2 starts at 0 and goes to 4
End Sub


Public Sub test2()
Dim ar1() As Variant
Dim ar2() As Variant
Dim ST As String
Dim i As Long, n As Long

ar1 = Range("A1", Range("A1").End(xlDown)).Value

ST = "*[[]*"

n = 1

For i = LBound(ar1) To UBound(ar1)
If ar1(i, 1) Like ST Then
ReDim Preserve ar2(1 To n)
ar2(UBound(ar2)) = ar1(i, 1)
n = n + 1
End If

Next i
End Sub

[SouthernStan]

Sam,

When I add your code I get

1st loop
i is 1And ar1,i,1 = Value 1

2nd loop
i is 2And ar1,i,1 = Value 2

etc etc.


Paul,

When I try your version I get a Subscript out of range error on the line

ReDim Preserve ar2(1 To n)

[Paul_Hossler]

Hmmm - Not for me

22210

[SouthernStan]

Thank you Paul.

What I was doing wrong is I did not declare n as a variable. After that your code worked.

Thank you for that.

Ok next question if I may.

I am now trying to expand what I can do with an excel range. so I have expanded my selection to include rows and colums:


ar1 = Range("A1", Range("A1").End(xlDown).End(xlToRight)).Value

This selects every thing in my sheet.

The value that I want to filer by is now in the "3rd spot" in the array list...


For i = LBound(ar1) To UBound(ar1)
If ar1(i, 3) Like ST Then

This works fine, it matches like I expect. But now instead of just copy one value to another as in the original code. I now want to try and copy the entire row...

The logic in my mind is thinking (but it doesnt work..) something like:


For i = LBound(ar1) To UBound(ar1) If ar1(i, 3) Like ST Then
ReDim Preserve ar2(1 To n)
ar2(UBound(ar2)) =ar1(i, 1 to end)' <---- I 'm not exactly sure how you tell vba that you want to copy all items under ar1(X)
n = n + 1
End If

[Paul_Hossler]

Little trickier since ReDIm Preserve only works on the last element

https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/redim-statement


Similarly, when you use Preserve, you can change the size of the array only by changing the upper bound; changing the lower bound causes an error. If you make an array smaller than it was, data in the eliminated elements will be lost. If you pass an array to a procedure by reference, you can't redimension the array within the procedure. When variables are initialized, a numeric variable is initialized to 0, a variable-length string is initialized to a zero-length string (""), and a fixed-length string is filled with zeros. Variant variables are initialized toEmpty (https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/vbe-glossary). Each element of a user-defined type variable is initialized as if it were a separate variable. A variable that refers to an object must be assigned an existing object using the Set statement before it can be used. Until it is assigned an object, the declaredobject variable (https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/vbe-glossary) has the special value Nothing, which indicates that it doesn't refer to any particular instance of an object. The ReDim statement acts as a declarative statement if the variable it declares doesn't exist atmodule level (https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/vbe-glossary) orprocedure level (https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/vbe-glossary). If another variable with the same name is created later, even in a wider scope (https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/vbe-glossary), ReDim will refer to the later variable and won't necessarily cause a compilation error, even if Option Explicit is in effect. To avoid such conflicts, ReDim should not be used as a declarative statement, but simply for redimensioning arrays.

Note To resize an array contained in a Variant, you must explicitly declare the Variant variable before attempting to resize its array.


Something like this is probably the simplest approach

Note that for 2 dim arrays, UBound() needs a second parameter to the dimension




Option Explicit

Public Sub test3()
Dim ar1() As Variant
Dim ar2() As Variant
Dim ST As String
Dim i As Long, j As Long, n As Long

ar1 = Range("A1").CurrentRegion.Value

ST = "*[[]*"

n = 0

For i = LBound(ar1) To UBound(ar1)
If ar1(i, 1) Like ST Then n = n + 1
Next i


ReDim ar2(1 To n, 1 To UBound(ar1, 2))

n = 1
For i = LBound(ar1, 1) To UBound(ar1, 1)
If ar1(i, 1) Like ST Then
For j = LBound(ar1, 2) To UBound(ar1, 2)
ar2(n, j) = ar1(i, j)
Next j
n = n + 1
End If
Next i
Stop

End Sub



22215

[SamT]

The value that I want to filer by is now in the "3rd spot" in the array list...


For i = LBound(ar1) To UBound(ar1)
If ar1(i, 3) Like ST Then
This works fine, it matches like I expect. But now instead of just copy one value to another as in the original code. I now want to try and copy the entire row...


Since Arrays declared like Array = Range.Value always start at Lbound = 1

For i = LBound(ar1) To UBound(ar1)
If ar1(i, 3) Like ST Then
Rows(i) Copy Destination:= SomeRange

'If you just want the part of the Row in the UsedRange then
Intersect(Rows(i), UsedRange).Copy Destination:=SomeRange
Of course, If the Array Range starts in other than Row 1, you will need to add some to i
Rows(i + ???).Copy....

[SouthernStan]

Paul,

I tried you code:
Its seems to work as I am getting data in Ar2. Awesome. Thank you

The issue for me is that its copying everything in AR1, not just the items that = ST


Dim ar1() As VariantDim ar2() As Variant
Dim ST As String
Dim i As Long
Dim n As Long
Dim J As Long




ar1 = Range("A1", Range("A1").End(xlDown).End(xlToRight)).Value


ST = "*[[]*"


n = 0


For i = LBound(ar1) To UBound(ar1)
If ar1(i, 3) Like ST Then
n = n + 1
End If
Next i




ReDim ar2(1 To n, 1 To UBound(ar1, 2))
n = 1
For i = LBound(ar1, 1) To UBound(ar1, 1)
If ar1(i, 3) Like ST Then
For J = LBound(ar1, 1) To UBound(ar1, 1)
Next J
n = n + 1
End If
Next i


End Sub

[Paul_Hossler]

That's not exactly the macro that I posted




Option Explicit
Sub test2()
Dim ar1() As Variant
Dim ar2() As Variant

Dim ST As String
Dim i As Long, n As Long, j As Long

ar1 = Range("A1", Range("A1").End(xlDown).End(xlToRight)).Value

ST = "*[[]*"

n = 0

For i = LBound(ar1) To UBound(ar1)
If ar1(i, 3) Like ST Then
n = n + 1
End If
Next i
ReDim ar2(1 To n, 1 To UBound(ar1, 2))

n = 1
For i = LBound(ar1, 1) To UBound(ar1, 1)
If ar1(i, 3) Like ST Then
For j = LBound(ar1, 2) To UBound(ar1, 2)
ar2(n, j) = ar1(i, j)
Next j
n = n + 1
End If
Next i
Stop
End Sub




My test data has 3 ST's in col C, and the macro finds then and copies the data in that row to ar2
22228


So my ar2 has 3 entries with the row data in
22227

That 'seems' like what you were asking - provide more information if not

[SouthernStan]

Paul,

Thanks for that. I try not to just blanket copy and paste code as I want to understand it, so Sometimes I may miss a few things.

What I am trying to understand right now is what this is doing:


For i = LBound(ar1, 1) To UBound(ar1, 1) If ar1(i, 3) Like ST Then
For j = LBound(ar1, 2) To UBound(ar1, 2)
ar2(n, j) = ar1(i, j)
Next j
n = n + 1
End If
Next i

I think i understand that its filtering on the 3rd item of the array "ar1(i,3) like st"

I also think that "ar2(n, j) = ar1(i, j)" is the actual copying of the record.

What I don't understand is what the line "For j = LBound(ar1, 2) To UBound(ar1, 2)" is doing

[Paul_Hossler]

In your #14


I now want to try and copy the entire row...


You have to go through each of the columns of ar1 for each row where the 3rd column is Like ST and put the data into ar2





' go down all the rows in ar1() -- the 1 = first dimension
For i = LBound(ar1, 1) To UBound(ar1, 1)

'if the 3rd entry in the I-th row of ar1 is Like ST, then ...
If ar1(i, 3) Like ST Then

'... go across the columns in the I-th row of ar1 -- the 2 = second dimension -- and ...
For j = LBound(ar1, 2) To UBound(ar1, 2)

'... put the ar1 j-th column of the I-th row into the n-th row, j-th column of ar2
ar2(n, j) = ar1(i, j)
Next j

'when all ar1 row I columns have been put in ar2, add 1 to n to get ready for the next ar1 where the 3rd column is Like ST
n = n + 1
End If
Next I

[SouthernStan]

Sorry for extended delay in responding. I got pulled into other projects at work.

I also wanted to say thanks for all the help. Its really helping me tremendously.

Now for my next question.

I now have an array that has all cells in a row.
22342

What I would like to lean now is how to take Ar2(1,3) and separate the three vales into there own records in the array with out the brackets..

In other words the end products would look something like:

Ar2(1,1) Hello
Ar2(1,2) Hi
Ar2(1,3) ABB
Ar2(1,4) 12345
Ar2(1,5) PartDescription1
Ar2(1,6) yes
Ar2(1,7) no
Ar2(1,8) etc


In my attempt to do this on my own I have tried the following code:


Sub GetRecords()



'This sub is inteded to sort through the original 'raw' excell sheet and pull out any desired rows for future use


Dim ar1() As Variant ' Array that will contain all records in the sheet
Dim Ar2() As Variant ' Array that will contain filtered records from AR1

Dim ST As String ' String that will contain item to filter ar1 on
Dim i As Long, n As Long, j As Long ' Create counters

' Places all cell in sheet into array
ar1 = Range("A1", Range("A1").End(xlDown).End(xlToRight)).Value

' Places the character [ into a varaible
ST = "*[[]*"

n = 0

'Loops through array looking for any string in item 3 that contains [ and then creates a new array that has enough rows to cotain found items
For i = LBound(ar1) To UBound(ar1)
If ar1(i, 3) Like ST Then
n = n + 1
End If
Next i
ReDim Ar2(1 To n, 1 To UBound(ar1, 2))

n = 1

'Loops through array again and places wanted rows into new array
For i = LBound(ar1, 1) To UBound(ar1, 1)
If ar1(i, 3) Like ST Then
For j = LBound(ar1, 2) To UBound(ar1, 2)
Ar2(n, j) = ar1(i, j)
Next j
n = n + 1
End If
Next i

'Moves the applcation to the next sub that works on items in new array
Call SeparateItems(Ar2)

End Sub


Sub SeparateItems(Ar2 As Variant)






Dim ar3 As Variant
Dim Oval As String
Dim i As Long, n As Long, j As Long


n = 0




For i = LBound(Ar2) To UBound(Ar2)
n = n + 1
Next i
ReDim ar3(1 To n, 1 To UBound(Ar2, 2))

n = 1


For i = LBound(Ar2) To UBound(Ar2)
For j = LBound(Ar2, 1) To UBound(Ar2, 1)
Oval = Ar2(i, 3)
ar3(n, j) = Split(Oval, "]")
Next j
n = n + 1
Next i


End Sub


This returns the Array like this:
22343


What am I doing wrong?

[Paul_Hossler]

Here's some sample logic that you can integrate into your macro

Just uses some dummy data in ar2, but ar3 is an array of arrays and each ar3 entry might have different number of enteries

22346



Option Explicit
Sub Fragment()
Dim ar2(1 To 2, 1 To 6) As String
Dim ar3() As Variant

Dim numRow As Long, numCol As Long
Dim s As String

'dummy data
ar2(1, 1) = "Hello"
ar2(1, 2) = "Hi"
ar2(1, 3) = "[ABB][12345][PartDescription1]"
ar2(1, 4) = "yes"
ar2(1, 5) = "no"
ar2(1, 6) = "etc"

ar2(2, 1) = "Hello2"
ar2(2, 2) = "Hi2"
ar2(2, 3) = "XXXXXXXXXXXXXXXXXXXX"
ar2(2, 4) = "yes2"
ar2(2, 5) = "no2"
ar2(2, 6) = "etc2"

'ar3 will be an array of arrays
ReDim ar3(LBound(ar2, 1) To UBound(ar2, 1))


For numRow = LBound(ar2, 1) To UBound(ar2, 1)
s = vbNullString

'make long string
For numCol = LBound(ar2, 2) To UBound(ar2, 2)
s = s & ar2(numRow, numCol) & Chr(1) ' just a marker
Next numCol

'delete last chr(1)
s = Left(s, Len(s) - 1)

s = Replace(s, "][", Chr(1))
s = Replace(s, "[", vbNullString)
s = Replace(s, "]", vbNullString)

'ar3 is 0-based, i.e. 0 to n-1
ar3(numRow) = Split(s, Chr(1))
Next numRow

'get the data out
For numRow = LBound(ar3) To UBound(ar3)
For numCol = LBound(ar3(numRow)) To UBound(ar3(numRow))
MsgBox numRow & " -- " & numCol & " --" & ar3(numRow)(numCol)
Next numCol
Next numRow


End Sub

[snb]

Removing a 'record' from a 2 dimensional array is identical to filtering the 'records' that shouldn't be removed

Removing records that contain 'snb' in column C is filtering the records that do not contain 'snb' in Column C.


Sub M_snb()
sn=Range("A1:E20")

for j=1 to ubound(sn)
if sn(j,3)<>"snb" then c00=c00 & " " & j
next

sn=application.index(sn,application.transpose(split(trim(c00))),array(1,2,3 ,4,5))
End Sub

Also available in: http://www.snb-vba.eu/VBA_Arrays_en.html#L_10
(http://www.snb-vba.eu/VBA_Arrays_en.html#L_10)
Alternatively you could use a 'virtual Active-X control'.


Sub M_snb()
sn=Range("A1:G20")

With CreateObject("New:{8BD21D20-EC42-11CE-9E0D-00AA006002F3}") ' - Microsoft Forms 2.0 ListBox
.List = sn
For j = .ListCount - 1 To 0 Step -1
If .List(j, 2) = "snb" Then .RemoveItem j
Next
sn = .List
End With

Cells(1, 10).Resize(UBound(sn) + 1, UBound(sn, 2) + 1) = sn
End Sub

Or you can use a Dictionary


Sub M_snb()
sn = Range("A1:K20").Value

With CreateObject("scripting.dictionary")
For j = 1 To UBound(sn)
If sn(j, 3) <> "snb" Then .Item(.Count) = Application.Index(sn, j)
Next
sn = Application.Index(.items, 0, 0)
End With
End Sub