VBA Copy and Paste function where two criteria are met

Question

I am brand new to VBA coding and am confused on how I would be able to copy and paste values from one sheet to another if two criteria points are met. In the sheet below I want to copy "12, 9, and 15" and paste it into the "Expected, P10 and P90" cells on sheet2 if the names on sheet one "Orange, Green" match those on sheet 1.

I've been attempting this on my own for quite some time now with now luck.

Attached is the code I started

Sub Copy_Certain_Data()

    a = Worksheets("Schedule Results").Cells(Rows.Count, 1).End(xlUp).Row


    For i = 3 To a

    If Worksheets("Schedule Results").Cells(i, 3).Value = "NE2P1" Then

    Worksheets("schedule results").Rows(i).Copy

    Worksheets("Campaign 1 Data").Activate

    Range("F2").Select

    ActiveSheet.Paste

    Worksheets("Schedule Results").Activate

    End If
    Next

    Application.CutCopyMode = False

End Sub

What have you tried so far? Please read the following: [How to Ask](https://stackoverflow.com/help/how-to-ask) and [How to Create a Minimal Reproducible Example](https://stackoverflow.com/help/minimal-reproducible-example). Doing this will help us help you find a solution. — Zack E, Jan 08 '20 at 19:07
SUMIFS will do this easily, does it need to be VBA. See: https://stackoverflow.com/questions/42492758/vlookup-using-2-columns-to-reference-another — Scott Craner, Jan 08 '20 at 19:08
I've tried using a for loop that ranged from 1 to the amount of rows on sheet one, the problem I'm having is how to get the range for the if statement to change every time it goes through the iterations — Mitchell Lawlor, Jan 08 '20 at 19:10
Please post the code you have tried. The one that got you the closest. — Scott Craner, Jan 08 '20 at 19:11
@ScottCraner It needs to be in a Macro as it will be used on different workbooks often as they are updated frequently. I thought that VBA was the only way to create an automatic macro like that — Mitchell Lawlor, Jan 08 '20 at 19:11
My guess is you dont have a counter in the loop to increase the variable by 1. — Zack E, Jan 08 '20 at 19:11
The code won't match the actual spreadsheets that I posted as the actual data is confidential. This is the code I used though — Mitchell Lawlor, Jan 08 '20 at 19:13
I have just updated the post to show what I have @ScottCraner — Mitchell Lawlor, Jan 08 '20 at 19:15

score 0 · Answer 1 · answered Jan 08 '20 at 20:53

This should give you a start to get you what you are trying to accomplished based on the code you have tried. Its always best practice to set your variables and also qualify worksheets.

Using .copy and .paste can cause issues because if the cells are not the same size you will get an error stating such and that is why I always set the destination cell value = the source cell value.

Option Explict
Sub Copy_Certain_Data()

    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet

    Set wb = ThisWorkbook
    Set wsSource = wb.Sheets("Schedule Results")
    Set wsDest = wb.Sheets("Campaign 1 Data")

    Dim LastRow As Long, i As Long

    LastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

    For i = 3 To LastRow
            If wsSource.Cells(i, 3).Value = "NE2P1" Then
                wsDest.Cells(i, 6) = wsSource.Cells(i, 3)
            End If
    Next i

End Sub

What if the destination values are not on the same row as sheet1? When looping through 2 worksheets you need to get the last row for each worksheet and loop through both worksheets. I would not use "NE2P1" because the OP is wanting to check the values in 2 columns, which is one of his problems. — GMalc, Jan 08 '20 at 21:10

score 0 · Accepted Answer · answered Jan 08 '20 at 21:10

Below is a basic macro to loop through two worksheets and find the row that has matching values in columns A and B. Then writing the values from the row in sheet 1, columns C:E to the row in sheet 2, columns D:F.

Dim ws1 As Worksheet, ws2 As Worksheet
Dim xCel As Range, yCel As Range

Set ws1 = ThisWorkbook.Sheets("Sheet1") 'change sheet names as needed
Set ws2 = ThisWorkbook.Sheets("Sheet2")

    For Each xCel In ws1.Range("A2", ws1.Range("A" & ws1.Rows.Count).End(xlUp)) 'loop sheet1 column A

        If xCel.Value = "Orange" And xCel.Offset(, 1).Value = "Green" Then 'when both values are found in row goto sheet2 loop

            For Each yCel In ws2.Range("A2", ws2.Range("A" & ws2.Rows.Count).End(xlUp)) 'Loop sheet2 Column A

                If yCel.Value = "Orange" And yCel.Offset(, 1).Value = "Green" Then 'when found write values from sheet1 to sheet2
                    yCel.Offset(, 3).Resize(, 3).Value = xCel.Offset(, 2).Resize(, 3).Value
                End If

            Next yCel
        End If
    Next xCel

Thanks @GMalc, is there a way now that I can have it do it for all of the cells instead of it just being for Orange and Green? — Mitchell Lawlor, Jan 09 '20 at 11:44
@MitchellLawlor this is not tested, but you should be able to use `Or` in the first `If loop` for each criteria set your want to test for. e.g. `If xCel.Value = "Orange" And xCel.Offset(, 1).Value = "Green" Or xCel.Value = "Banana" And xCel.Offset(, 1).Value = "Blue" Then` Or you could add separate `ElseIf` statements for each criteria set you want to test for. — GMalc, Jan 09 '20 at 12:46

VBA Copy and Paste function where two criteria are met

2 Answers2