Question

I’m trying to write a macro that will copy the rows if 3 conditions are met. Such as:

If “A” = B and “D” = E and “F” = G
Then copy row into next available row on sheet 2

If “A” = C and “D” = F and “F” = H
Then copy row into next available row on sheet 2

I need to repeat the above steps up to 50 times. The columns will not change

This is what I have so far:

`Sub SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 4
LSearchRow = 4

'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

    'If value in column E = "Mail Box", copy entire row to Sheet2
    'If value in column D = "0", copy entire row to Sheet2
    'If value in column A = "5", copy entire row to Sheet2
    'If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then
    If Range("F" & CStr(LSearchRow)).Value = "Mail Box" And _
        Range("E" & CStr(LSearchRow)).Value = "0" And _
        Range("A" & CStr(LSearchRow)).Value = "5" Then

 'If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then

        'Select row in Sheet1 to copy
        Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
        Selection.Copy

        'Paste row into Sheet2 in next row
        Sheets("Sheet2").Select
        Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
        ActiveSheet.Paste

        'Move counter to next row
        LCopyToRow = LCopyToRow + 1

        'Go back to Sheet1 to continue searching
        Sheets("Sheet1").Select

        End If

    LSearchRow = LSearchRow + 1

    Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

'MsgBox "All matching data has been copied."

'Exit Sub


        'Search 2

         'Start search in row 4
LSearchRow = 4

'Start copying data to row 3 in Sheet2 (row counter variable)
LCopyToRow = 3

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

    'If value in column E = "Mail Box", copy entire row to Sheet2
    'If value in column D = "1", copy entire row to Sheet2
    'If value in column A = "5", copy entire row to Sheet2
    'If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then
    If Range("F" & CStr(LSearchRow)).Value = "Mail Box" And _
        Range("E" & CStr(LSearchRow)).Value = "1" And _
        Range("A" & CStr(LSearchRow)).Value = "5" Then

 'If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then

        'Select row in Sheet1 to copy
        Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
        Selection.Copy

        'Paste row into Sheet2 in next row
        Sheets("Sheet2").Select
        Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
        ActiveSheet.Paste

        'Move counter to next row
        LCopyToRow = LCopyToRow + 1

        'Go back to Sheet1 to continue searching
        Sheets("Sheet1").Select

    End If

    LSearchRow = LSearchRow + 1

Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

 Err_Execute:
MsgBox "An error occurred."

End Sub

Answer 1

I think there’s probably a better way to do what you’re trying to acheive, but maybe this will help you along…

Sub Tester()
    SearchForString "5", "0", "Mail Box"
    SearchForString "5", "1", "Mail Box"
End Sub

Sub SearchForString(ColA, ColE, ColF)

Dim LSearchRow As Long
Dim shtSearch As Worksheet
Dim shtCopyTo As Worksheet
Dim rw As Range

    LSearchRow = 4 'Start search in row 4

    Set shtSearch = Sheets("Sheet1")
    Set shtCopyTo = Sheets("Sheet2")

    Do While Len(shtSearch.Cells(LSearchRow, 1).Value) > 0

        Set rw = shtSearch.Rows(LSearchRow)

        If rw.Cells(6).Value = ColF And rw.Cells(5).Value = ColE And _
                                        rw.Cells(1).Value = ColA Then

            rw.Copy shtCopyTo.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            Exit Do '? you say there's only one result to find
        End If
        LSearchRow = LSearchRow + 1
    Loop
End Sub