VBA - Copying multiple rows if if they meet a criteria

jpringle1

New Member
Joined
Jan 4, 2019
Messages
7
here is a brief of what i'm trying to achieve:

The rows in the source table highlighted in red are already present in the destination table, so i DONT want to copy them over to the destination table.
However, if a single cell in any of those rows didn't match the corrosponing field in the destination table, then i'd want the whole row to be added to the bottom of the destination table as if it were all brand new data.

I'd like the macro to check this criteria with every row in the table and paste the matching rows onto the bottom of the destination table.

I posted this question on the excelforum yesterday and got halfway to where i need to be, but no-one has replied in a while and i need this done by today. here is a link:
https://www.excelforum.com/excel-programming-vba-macros/1258549-copying-multiple-rows-if-a-certain-cell-in-those-row-meets-a-criteria.html#post5037558


So far i've worked out how to match and paste the rows onto a different table, but there are a couple things i still need to tweak before i can call this a success.:
First of all, there are some columns in the source table which i DON'T want copied over to the destination table, but there are columns after it which i do (see the column labelled "day rate").
Second, I need to insert text in a column in the destination table which doesn't exist in the source table. (see the column labelled "fuel", i need every row which gets copied over to have "electricity" written in that column automatically)

Here is the code i am using:
<code><code>
Code:
</code>Sub CopyRows()
    Application.ScreenUpdating = False
    Dim Val As String, ws1 As Worksheet, ws2 As Worksheet, lastRow1 As Long, lastRow2 As Long
    Set ws1 = Sheets("[COLOR=#FF0000]Sheet1[/COLOR]")
    Set ws2 = Workbooks("[COLOR=#FFA500]Book2.xlsx[/COLOR]").Sheets("[COLOR=#0000FF]Sheet1[/COLOR]")
    lastRow1 = ws1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lastRow2 = ws2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim i&, v1, v2
    v1 = ws1.Range("A2:A" & lastRow1).Resize(, 4).Value
    v2 = ws2.Range("A2:A" & lastRow2).Resize(, 4).Value
    Application.ScreenUpdating = False
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(v2, 1)
            Val = (v2(i, 1)) & "|" & (v2(i, 2)) & (v2(i, 3)) & (v2(i, 4))
            If Not .Exists(Val) Then
                .Add Val, Nothing
            End If
        Next i
        For i = 1 To UBound(v1, 1)
            lastRow2 = ws2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Val = (v1(i, 1)) & "|" & (v1(i, 2)) & (v1(i, 3)) & (v1(i, 4))
            If Not .Exists(Val) Then
                ws1.Cells(i + 1, 1).Resize(1, 4).Copy ws2.Cells(lastRow2 + 1, 1)
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub</code><code>
</code>


604502d1546597324-copying-multiple-rows-if-a-certain-cell-in-those-row-meets-a-criteria-capture.png


Any help is much appreciated
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top