Declare correctly a two dimensional dynamic array

boerner

New Member
Joined
Aug 8, 2012
Messages
6
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

Code:
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
 

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,276
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

MrExcel MVP
Joined
Aug 23, 2010
Messages
16,393
See if this works - corrections in red

Code:
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

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,307
Office Version
  1. 2010
Platform
  1. Windows
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.
 

boerner

New Member
Joined
Aug 8, 2012
Messages
6
Thanks to all three of you, AlphaFrog, Marcelo and Rick, for your lightning fast replies! My macro works fine now.

Boris
 

Watch MrExcel Video

Forum statistics

Threads
1,108,924
Messages
5,525,654
Members
409,658
Latest member
Yardcell

This Week's Hot Topics

Top