Select Loop in VBA only selects last row

Question

I have a worksheet (#1) containing a list of row numbers that correspond to worksheet #2. There are about 650 rows that I need to select in worksheet #2 (out of a total of 11,000ish rows in worksheet #2).

I got as far as making this little vba script

Sub SelectRows()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet

Set wb1 = Workbooks("worksheet1")
Set wb2 = Workbooks("woorksheet2")

Set ws1 = wb1.Sheets("Sheet1")
Set ws2 = wb2.Sheets("Sheet2") 

For Each Row In ws1.Range("A1:A650").Cells
    ws2.Rows(Row).Select
Next
End Sub

The problem I run into, is that after the script runs, it will only have selected the very last row# from worksheet#1.

so if worksheet#1 looks like this...

1

6

100

...

5670

I am only able to select row 5670 on worksheet#2 after running my program.

How can I tell VBA that I want to continually add to my selection instead of just re-selecting the next row?

EDIT For those who are unclear..

I have a large spreadsheet containing over 11,000 rows of data. I need to select around 600 rows from this spreadsheet. However, I only know the row# of the data that I need to select from this spreadsheet.

So, I have created a second spreadsheet that lists in A1:A600 the row numbers that I need to select in my aforementioned spreadsheet.

Yes, this is a terrible way to do things. Yes, if there was any other way of selecting data other then row#, I would do it. Simply put, in my situation, there is not. If you do not believe I have been trying to solve this problem all day, that is fine, you may downvote this question.

Answer 1

I am going to suggest a more efficient approach, that uses variant arrays.

The strategy is as follows:

• Setup the worksheet / workbook objects (as you have done so far)
• Store the indexes into a Variant array (named vIndex)
• Store the contents into another Variant array (named vContent)
• Paste vContent into a range

Here is the code:

Sub CopyPaste()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim vIndex As Variant, vContent As Variant
    Dim lCounter As Long

    ' This is the workbook that contains the index range
    Set wb1 = ThisWorkbook

    ' Or whatever name
    Set wb2 = Workbooks("Other Sheet")

    Set ws1 = Sheet1
    ' First sheet of Workbook2 - change accordingly
    Set ws2 = wb2.Sheets(1)

    ' Store index range to a variant array, for efficiency
    ' I used A2:A25 for my tests, change it to A1:A650
    vIndex = ws1.Range("A2:A25").Value2

    ' Initialize the array to be selected/copied
    ReDim vContent(1 To UBound(vIndex, 1))

    ' Populate the content array, based on the rows shown by the index array
    For lCounter = 1 To UBound(vIndex, 1)
        vContent(lCounter) = ws2.Cells(vIndex(lCounter, 1), 1).EntireRow.Value2
    Next lCounter
' Let's paste it next to another worksheet
For lCounter = 1 To UBound(vIndex, 1)
    wb1.Sheets(2).Range("A" & lCounter).Resize(1, UBound(vContent(1), 2)).Value2 = vContent(lCounter)
Next lCounter
End Sub

---

EDIT

Edited to copy all row contents (tried and tested).

I strongly suggest you do not copy the entire row, but rather restrict to the space in which you have data.

Answer 2

If you need to copy/paste each row then try doing it on the fly as you loop. This is a example that can be adapted:

Sub SelectRowsx()

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet

Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Set ws3 = ThisWorkbook.Sheets("Sheet3")

Dim cell
Dim r As Integer
For Each cell In ws1.Range("A1:A3").Cells
    ws2.Rows(2).EntireRow.Copy
    With ws3
       r = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    ws3.Range("A" & r).PasteSpecial xlPasteValues
Next

End Sub

Adapted to your situation:

Sub SelectRowsY()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws3 As Worksheet '<<new: the repository of the row copies

Set wb1 = Workbooks("worksheet1")
Set wb2 = Workbooks("woorksheet2")

Set ws1 = wb1.Sheets("Sheet1")
Set ws2 = wb2.Sheets("Sheet2")
Set ws3 = wb1.Sheets("Sheet3") '<<new: the repository of the row copies


Dim cell
Dim r As Integer
For Each cell In ws1.Range("A1:A650").Cells
    ws2.Rows(cell.Value).EntireRow.Copy
    With ws3
       r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 '<<find last empty row: the place the copy will be pasted
    End With
    ws3.Range("A" & r).PasteSpecial xlPasteValues
Next
End Sub

Seems like it is possible to build up a range made up of disperate rows inside the loop via the method Union - then this range can be copy/pasted to a different location:

Sub SelectRowsT()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet '<<new: the repository of the row copies

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3") '<<new: the repository of the row copies


Dim cell
Dim r As Integer
Dim rn As Range
Dim selRange As Range
For Each cell In ws1.Range("A1:A3").Cells
    Set rn = ws2.Rows(cell.Value).EntireRow
    If (selRange Is Nothing) Then
        Set selRange = rn
    Else
        Set selRange = Union(selRange, rn)
    End If
Next

selRange.Copy
With ws3
   r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 '<<find last empty row: the place the copy will be pasted
End With
ws3.Range("A" & r).PasteSpecial xlPasteValues

End Sub

Answer 3

You're going to need to define lastRow and add a new sheet (ws3) but I hope the logic makes sense. Should add that I am assuming the rows you want are in column A.

For i = 1 To LastRow
'r = row number wanted
r = ws2.Cells(i, 1)
'drop into new sheet
ws3.Rows(i) = ws1.Rows(r)
Next i

Answer 4

In these lines of your code:

For Each Row In ws1.Range("A1:A650").Cells
    ws2.Rows(Row).Select
Next

Row is a range. To get the row number you need Row.Row:

For Each Row In ws1.Range("A1:A650").Cells
    ws2.Rows(Row.Row).Select
Next

This might have been easier to see if you had used a variable name other than Row:

For Each c In ws1.Range("A1:A650").Cells
    ws2.Rows(c.Row).Select
Next

Hope that helps