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.

: 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

Capture.JPG

[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...edim-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. 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 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 orprocedure level. If another variable with the same name is created later, even in a wider scope, 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

Capture.JPG

[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
Capture2.JPG


So my ar2 has 3 entries with the row data in
Capture.JPG

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