Declare correctly a two dimensional dynamic array

[Legacy 223018]

Hi there,

I'm stuck with a search / copy macro in Excel. What I am trying to do is to modify a piece of code I used before. I was searching a range in sheet A (wsOut) for an item X and copy the entire line to sheet B (wsIn) if X was found within the range. I did this through an input box. As there are many items to search for, I would like to use an array to search for all of them at the same time, instead of reopening the input box for every item to search.

What I imagined is to put a list of items into a column (here: column U, starting at cell U3) of my control sheet (wsInfo). I would like to have the option to change and, above all, extend the list later. Thus the array should be within [U3:U, LastRowInfo]. The search will still be performed in the source sheet (wsOut) and the entire lines of the hits will still be copied to the destination sheet's (wsIn) first empty line.

I feel my problems are to (1) declare and (2) define the array correctly. If I am not mistaken, this is a two-dimensional, dynamic array. Can anyone help me to correct the errors in my code (I marked in the code where I get in trouble)?

Thanks a lot in advance!

Boris

Private Sub SearchCopy()


Dim LastRow As Long
Dim Rng As Range
Dim FirstAddress As String
Dim wsOut As Worksheet
Dim wsIn As Worksheet
Dim wsInfo As Worksheet
Dim MyArr As Variant
Dim I As Long
Dim LastRowInfo As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Set wsOut = ThisWorkbook.Sheets("SITCOM_DB")
    Set wsIn = ThisWorkbook.Sheets("SITCOM_SELECTION")
    Set wsInfo = ThisWorkbook.Sheets("Info")
    LastRow = wsIn.Range("B" & Rows.Count).End(xlUp).Row + 1
    LastRowInfo = wsInfo.Range("U" & Rows.Count).End(xlUp).Row
    
' I get an "application defined / object defined" error here:
    MyArr = wsInfo.Range("U3:U", LastRowInfo)
    
    With wsOut.Range("B:R", "BF:BG")

' I get a "subscript out of range" error here:
       For I = LBound(MyArr) To UBound(MyArr)
        
        Set Rng = .Find(What:=MyArr(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
        If Not Rng Is Nothing Then
            FirstAddress = Rng.Address
            Do
            Rng.EntireRow.Copy
            wsIn.Select
            wsIn.Cells(LastRow, 1).Select
            Selection.PasteSpecial (xlValues)
            Set Rng = .FindNext(Rng)
            Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
        End If
        
       Next I
    
    End With


With Application
        .ScreenUpdating = True
        .EnableEvents = True
End With
    
wsOut.Cells(1, 1).EntireRow.Copy wsIn.Cells(1, 1)


End Sub

 

[AlphaFrog]

Declaring MyArr as variant is correct.

Syntax issue:
MyArr = wsInfo.Range("U3:U" & LastRowInfo).Value


Though MyArr only has one column, it is a two dimensional array (n rows by one column). Both indexes are required to reference an element within the array.

For I = LBound(MyArr, 1) To UBound(MyArr, 1) 'LBound\Ubound of the 1st dimension


.Find(What:=MyArr(I, 1) 'reference row I column 1

 

[Marcelo Branco]

See if this works - corrections in red

Private Sub SearchCopy()
Dim LastRow As Long
Dim Rng As Range
Dim FirstAddress As String
Dim wsOut As Worksheet
Dim wsIn As Worksheet
Dim wsInfo As Worksheet
Dim MyArr As Variant
Dim I As Long
Dim LastRowInfo As Long
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Set wsOut = ThisWorkbook.Sheets("SITCOM_DB")
    Set wsIn = ThisWorkbook.Sheets("SITCOM_SELECTION")
    Set wsInfo = ThisWorkbook.Sheets("Info")
    LastRow = wsIn.Range("B" & Rows.Count).End(xlUp).Row + 1
    LastRowInfo = wsInfo.Range("U" & Rows.Count).End(xlUp).Row
    
' I get an "application defined / object defined" error here:
    [COLOR=#ff0000]MyArr = wsInfo.Range("U3:U" & LastRowInfo)[/COLOR]
    
    With wsOut.Range("B:R", "BF:BG")
' I get a "subscript out of range" error here:
       [COLOR=#ff0000]For I = LBound(MyArr, 1) To UBound(MyArr, 1)
[/COLOR]        
        Set Rng = .Find(What:=[COLOR=#ff0000]MyArr(I, 1)[/COLOR], _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
        If Not Rng Is Nothing Then
            FirstAddress = Rng.Address
            Do
            Rng.EntireRow.Copy
            wsIn.Select
            wsIn.Cells(LastRow, 1).Select
            Selection.PasteSpecial (xlValues)
            [COLOR=#ff0000]LastRow = LastRow + 1[/COLOR]
            Set Rng = .FindNext(Rng)
            Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
        End If
        
       Next I
    
    End With

With Application
        .ScreenUpdating = True
        .EnableEvents = True
End With
    
wsOut.Cells(1, 1).EntireRow.Copy wsIn.Cells(1, 1)
End Sub

Hope this helps

M.

 

[Rick Rothstein]

Though MyArr only has one column, it is a two dimensional array (n rows by one column). Both indexes are required to reference an element within the array.

For I = LBound(MyArr, 1) To UBound(MyArr, 1) 'LBound\Ubound of the 1st dimension

.Find(What:=MyArr(I, 1) 'reference row I column 1

I just want to point out that the second argument to LBound and UBound is optional and defaults to 1 if omitted. That does not violate your "both indexes are required" statement because LBound and UBound are not accessing an individual element of the array (for which both indexes are required to do), rather, they are accessing a property of the entire array itself.

 

[Legacy 223018]

Thanks to all three of you, AlphaFrog, Marcelo and Rick, for your lightning fast replies! My macro works fine now.

Boris