Inserting Range into Array in VBA for iteration

Question

I am facing some issues with VBA. Let me explain what I am trying to achieve. I have 2 sheets in 1 workbook. They are labelled "Sheet1" and "Sheet2."

In "Sheet1," there are 100 rows and 100 columns. In column A, it is filled with eg: SUBJ001 all the way to SUBJ100. In "Sheet2," there is only 1 Column A, with a range of rows. Eg: "SUBJ003, SUBJ033, SUBJ45." What I am trying to achieve is to use my mouse, highlight the column A in "Sheet2," and compare each individual cell with the cells in column A. Should there be a match, it will copy the entire row and paste them in a new sheet that the macro creates in the same workbook. However, i am experiencing an out of range error at Set Rng =.Find(What:=Arr(I), ... Thanks!

Sub Copy_To_Another_Sheet_1()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim Rcount As Long
Dim I As Long
Dim NewSh As Worksheet

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Set Rng = Application.InputBox("Select target range with the mouse", Type:=8)

MyArr = Rng

Set NewSh = Worksheets.Add

With Sheets("Sheet1").Range("A:A")

    Rcount = 0

    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
                Rcount = Rcount + 1

                Rng.EntireRow.Copy NewSh.Range("A" & Rcount)

                ' Use this if you only want to copy the value
                ' NewSh.Range("A" & Rcount).Value = Rng.Value

                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

End Sub

YowE3K YowE3K · Accepted Answer · 2017-11-01T02:09:47

MyArr = Rng is setting MyArr to be a two-dimensional array where the first rank corresponds to the rows in Rng and the second rank corresponds to the columns in Rng.

Assuming you only have one column in Rng, then your Find statement should refer to the values in that first column using MyArr(I, 1), i.e.

    Set Rng = .Find(What:=MyArr(I, 1), _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlFormulas, _
                    LookAt:=xlPart, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)

Inserting Range into Array in VBA for iteration

1 Answers