1

I need this code to search through a table in sheet1 and copy across the rows which match a certain criteria,

any tips on where I am going wrong?

Sub find_orders()

Application.ScreenUpdating = False

Dim r As Long, endRow As Long, pasteRowIndex As Long

endRow = Sheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Row

pasteRowIndex = 2

For r = 2 To endRow
    If Cells(r, 6) = "d" Then
        Range(Cells(r, 2), Cells(r, 6)).Copy
        Sheets("sheet2").Select
        Range(Cells(pasteRowIndex, 2), Cells(pasteRowIndex, 6)).Select

        pasteRowIndex = pasteRowIndex + 1
        Sheets("sheet1").Select


        End If

Next r

End Sub
Scott Craner
  • 148,073
  • 10
  • 49
  • 81
AL92
  • 45
  • 2
  • 3
  • 6

2 Answers2

0

As @findwindow stated you need to qualify all your ranges and cells:

Sub find_orders()

Application.ScreenUpdating = False

Dim r As Long, endRow As Long, pasteRowIndex As Long
Dim ows As ws
Dim tws As ws

Set ows = Sheets("Sheet1")
Set tws = Sheets("Sheet2")

With ows
    endRow = .Cells(Rows.Count, 2).End(xlUp).Row

    pasteRowIndex = 2

    For r = 2 To endRow
        If .Cells(r, 6) = "d" Then
            .Range(.Cells(r, 2), .Cells(r, 6)).Copy
            tws.Range(tws.Cells(pasteRowIndex, 2), tws.Cells(pasteRowIndex, 6)).PasteSpecial
            pasteRowIndex = pasteRowIndex + 1
        End If
    Next r
End With

End Sub

By qualifieng the ranges you can avoid using the .Select command. Which slows done the code.

Community
  • 1
  • 1
Scott Craner
  • 148,073
  • 10
  • 49
  • 81
0

Try the following:

Sub find_orders()

Application.ScreenUpdating = False

Dim r As Long
Dim endRow1 As Long
Dim endRow2 As Long

endRow1 = Sheets("sheet1").Cells(Sheets("sheet1").Rows.Count, 2).End(xlUp).Row
endRow2 = Sheets("sheet2").Cells(Sheets("sheet2").Rows.Count, 2).End(xlUp).Row
endRow2 = endRow2 + 1

For r = 2 To endRow
    If Cells(r, 6) = "d" Then     'searches in column f for the letter "d" in a cell, correct?
        Range(Cells(r, 2), Cells(r, 6)).Select
        Selection.Copy
        Sheets("sheet2").Select
        Range(Cells(endrow2, 2), Cells(endrow, 6)).Select
        Selection.Paste

        Sheets("sheet1").Select

     End If
Next r

End Sub

The Problem is that in your code the pasteRowIndex was always 2 as you had defined it before the if-loop (I had the same problem once). I also added a little more informations in your code, as it is always good to be very specific especially in VBA ;)

Kathara
  • 1,226
  • 1
  • 12
  • 36
  • 1. the pasterow index is changing, because it set to 2 before the loop and each time the if statement is true it increments by 1. 2. using `.select` is generally a bad practice, one should qualify the ranges and cells instead. – Scott Craner Jan 08 '16 at 16:13