Trouble - pass cell values to an Array in VBA

[PVA0724]

Hi

I'm used the code below in the past to select from a set of an array (same variables) to copy / paste into the last line it works as it suppose to do it. Nevetheless now the one single rule change, I have to choose from a set of variables within the same range, where the variables are defined each time by the user, meaning it changes each time. So I try to built in the array based on values on a specific range in Sheets(1) and even when it doesn't trigger an error it doesn't execute what is expected (copy / paste) based on the array. I'm highlighting in red the part code that I think needs to be change, but I don't know how...so any help is more than welcome.

Sub SearchForString()
    Dim LSearchRow As Integer
    Dim LCopyToRow As Integer
    Dim ArrayCo As Variant
    Dim I As Integer
 
         
    'On Error GoTo Err_Execute
    'Start search in row 4
    LSearchRow = 3
    'Start copying data to row 2 in Sheet2 (row counter variable)
    LCopyToRow = 2
    While Len(Range("A" & CStr(LSearchRow)).Value) > 0
    
    [B][COLOR=red]ArrayCo = Application.Transpose(Sheets(1).Range("B2:B12").Value)[/COLOR][/B]
   Application.ScreenUpdating = False
    
    For I = 0 To UBound(ArrayCo)
    
        'If value in column A = ArrayCo and Invoice Coding And PO Redistribution, copy entire row to Sheet2
        If Range("A" & CStr(LSearchRow)).Value = ArrayCo(I) And _
        Range("H" & CStr(LSearchRow)).Value = "Invoice Coding" Or _
        Range("A" & CStr(LSearchRow)).Value = ArrayCo(I) And _
        Range("H" & CStr(LSearchRow)).Value = "PO Redistribution" Then
            
        'Select Copy from Doxis Costa Rica
        
        Sheets(3).Select
        Range(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy
        
        'Select Destination to Paste
        
        Sheets(2).Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
        
            'Move counter to next row
            LCopyToRow = LCopyToRow + 1
            'Go back to  Costa Rica to continue searching
            Sheets(3).Select
        End If
        LSearchRow = LSearchRow + 1
    
    Next I
    Wend
    'Position on cell A3
    Application.CutCopyMode = False
    Range("A3").Select
    MsgBox "All matching data has been copied."
    Exit Sub
'Err_Execute:
    'MsgBox "An error occurred."
End Sub

 

[shg]

Try this:

Sub SearchForString()
    Dim iRow        As Long
    Dim av          As Variant
    Dim i           As Long
 
    Application.ScreenUpdating = False
    iRow = 3
    av = Application.Transpose(Worksheets(1).Range("B2:B12").Value)
 
    With Worksheets(3)
        Do Until IsEmpty(.Cells(iRow, "A").Value)
            For i = 0 To UBound(av)
                If .Cells(iRow, "A").Value = av(i) And _
                   .Cells(iRow, "H").Value = "Invoice Coding" Or _
                   .Cells(iRow, "A").Value = av(i) And _
                   .Cells(iRow, "H").Value = "PO Redistribution" Then
                    .Rows(iRow).Copy Worksheets(2).Cells(Rows.Count, "A").End(xlUp).Offset(1)
                End If
                iRow = iRow + 1
            Next i
        Loop
 
        Application.CutCopyMode = False
        .Range("A3").Select
    End With
    MsgBox "All matching data has been copied."
End Sub

If it doesn't work, what happens when you step through it?

 

[PVA0724]

Hi Thanks for the reply

I did as suggested, but the code returns the error "Run Time Error 9 Suscript out of range in the red part of the code - any guideline on how to fix it?

Sub SearchForString()
    Dim iRow        As Long
    Dim av          As Variant
    Dim i           As Long

    Application.ScreenUpdating = False
    iRow = 3
    av = Application.Transpose(Worksheets(1).Range("B2:B12").Value)

    With Worksheets(3)
        Do Until IsEmpty(.Cells(iRow, "A").Value)
            For i = 0 To UBound(av)
                [COLOR=red][B]If .Cells(iRow, "A").Value = av(i) And _
                   .Cells(iRow, "H").Value = "Invoice Coding" Or _
                   .Cells(iRow, "A").Value = av(i) And _
                   .Cells(iRow, "H").Value = "PO Redistribution" Then
[/B][/COLOR]                    .Rows(iRow).Copy Worksheets(2).Cells(Rows.Count, "A").End(xlUp).Offset(1)
                End If
                iRow = iRow + 1
            Next i
        Loop

        Application.CutCopyMode = False
        .Range("A3").Select
    End With
    MsgBox "All matching data has been copied."
End Sub

 

[PVA0724]

RESOLVED: Trouble - pass cell values to an Array in VBA

Hi Shg

Thanks for the tip on the code...I was able to fix from your departing point, it looks that the array can't start from 0 to ... due cell 0 doesn't exist so I was able to change to 1 and add an extraline to always detect the last cell use as follow: - Againg thanks and hope this also helps another people around the forum

Sub SearchForString()
    Dim iRow        As Long
    Dim Co          As Variant
    Dim i           As Long
 
    Application.ScreenUpdating = False
    iRow = 3
    
    ult = Worksheets(1).Cells(Rows.Count, "B").End(xlUp).Row
    
    Co = Application.Transpose(Worksheets(1).Range("B2:B" & ult).Value)
 
    With Worksheets(3)
        Do Until IsEmpty(.Cells(iRow, "A").Value)
            For i = 1 To UBound(Co)
                If .Cells(iRow, "A").Value = Co(i) And _
                   .Cells(iRow, "H").Value = "Invoice Coding" Or _
                   .Cells(iRow, "A").Value = Co(i) And _
                   .Cells(iRow, "H").Value = "PO Redistribution" Then
                    .Rows(iRow).Copy Worksheets(2).Cells(Rows.Count, "A").End(xlUp).Offset(1)
                End If
                iRow = iRow + 1
            Next i
        Loop
 
        Application.CutCopyMode = False
        .Range("A3").Select
    End With
    MsgBox "All matching data has been copied."
End Sub

 

[shg]

On what part? Hover over av(i) -- it that correct? Look at av in the immediate window.

 

[PVA0724]

Hi Shg

On my first test of your suggested code, there was an error on this part

 If .Cells(iRow, "A").Value = Co(i) And _
                   .Cells(iRow, "H").Value = "Invoice Coding" Or _
                   .Cells(iRow, "A").Value = Co(i) And _
                   .Cells(iRow, "H").Value = "PO Redistribution" Then
                    .Rows(iRow).Copy Worksheets(2).Cells(Rows.Count, "A").End(xlUp).Offset(1)
                End If

So what I did after a couple of research over was to change the "For" statement rather than

For i = 0 To UBound(Co)

to

For i = 1 To UBound(Co)

so the new final code is

Sub SearchForString()
    Dim iRow        As Long
    Dim Co          As Variant
    Dim i           As Long
 
    Application.ScreenUpdating = False
    iRow = 3
    
    ult = Worksheets(1).Cells(Rows.Count, "B").End(xlUp).Row
    
    Co = Application.Transpose(Worksheets(1).Range("B2:B" & ult).Value)
 
    With Worksheets(3)
        Do Until IsEmpty(.Cells(iRow, "A").Value)
            For i = 1 To UBound(Co)
                If .Cells(iRow, "A").Value = Co(i) And _
                   .Cells(iRow, "H").Value = "Invoice Coding" Or _
                   .Cells(iRow, "A").Value = Co(i) And _
                   .Cells(iRow, "H").Value = "PO Redistribution" Then
                    .Rows(iRow).Copy Worksheets(2).Cells(Rows.Count, "A").End(xlUp).Offset(1)
                End If
                iRow = iRow + 1
            Next i
        Loop
 
        Application.CutCopyMode = False
        .Range("A3").Select
    End With
    MsgBox "All matching data has been copied."
End Sub

Now, based on your inquire, that's make me think if what I did was correct or not? Could you please advise? Thanks!

 

[shg]

Good job. A range copied to an array always has a base of 1.