Comparing Multiple Criteria Across Two Worksheets to Find and Migrate Rows

R

reberryjr

Well-known Member
Joined
Mar 16, 2017
Messages
714
Office Version
  1. 365
Platform
  1. Windows
I'm trying to find a way to identify instances from my Incoming Volume worksheet, that do not exist on my Working Population worksheet, and copy them over to the Working Population worksheet. I think I'm good on how to copy and paste, but I'm not certain on the best method to go through each row on the Incoming Volume worksheet, and determine if the record exists on the Working Population worksheet.

I would want to move record over if the value in column H and the value in column Q of the Incoming Volume worksheet does not match the value in column O and X of the Working Population worksheet.

Incoming Volume
Column H = AcctNbr
Column Q = Notified

Working Population
Column O = AcctNbr
Column X = Notified
 
Sort by date Sort by votes
It's copying over the entire volume from the source spreadsheet, instead of only the records that don't exist on the destination sheet.
 
Upvote 0

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
I figured it out. I had the RngList set as iRngList, but not dimmed that way.
 
Upvote 0
Glad it worked out.
 
Last edited:
Upvote 0
@mumps I have a similar issue as this one, but with a different project. I'm struggling to find a way to add another offset condition, so that I'm comparing 3 sets of criteria instead of 2. Essentially, I need to add values from columns C, F & L from rws2 to the dictionary, and compare against columns A, C & E from iws1.

Here's the code that I have now:

Code: 
Private Sub cmd_Import_Click()
Application.ScreenUpdating = False
Dim r, i As Workbook
Dim rws2, iws1 As Worksheet
Dim Rng As Range
Dim RngList As Object
Dim rLR2 As Long
Set r = ThisWorkbook
Set rws2 = ThisWorkbook.Sheets("Consolidated")
Set RngList = CreateObject("Scripting.Dictionary")
Set i = Workbooks.Open("[URL="file://\\Path"]\\Path[/URL]")
Set iws1 = i.Sheets("Data")
For Each Rng In rws2.Range("C2", rws2.Range("C" & rws2.Rows.Count).End(xlUp))
    If Not RngList.Exists(Rng.Value & Rng.Offset(0, 9)) Then 'I need to also add a condition to look at Offset 0,2
        RngList.Add Rng.Value & Rng.Offset(0, 9), Nothing
    End If
Next
For Each Rng In iws1.Range("A2", iws1.Range("A" & iws1.Rows.Count).End(xlUp))
    If Not RngList.Exists(Rng.Value & Rng.Offset(0, 4)) Then 'I need to also add a condition to look at Offset 0,2
        rws2.Range("C" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("A" & Rng.Row)
        rws2.Range("D" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("B" & Rng.Row)
        rws2.Range("F" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("C" & Rng.Row)
        rws2.Range("J" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("D" & Rng.Row)
        rws2.Range("L" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("E" & Rng.Row)
        rws2.Range("M" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("F" & Rng.Row)
        rws2.Range("N" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("G" & Rng.Row)
        rws2.Range("O" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("H" & Rng.Row)
        rws2.Range("P" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("I" & Rng.Row)
        rws2.Range("Q" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("J" & Rng.Row)
        rws2.Range("S" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("K" & Rng.Row)
        rws2.Range("T" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("L" & Rng.Row)
        rws2.Range("U" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("M" & Rng.Row)
        rws2.Range("V" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("N" & Rng.Row)
        rws2.Range("W" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("O" & Rng.Row)
        rws2.Range("Y" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("P" & Rng.Row)
        If iws1.Range("Q" & Rng.Row) = "" Then
            rws2.Range("Z" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("R" & Rng.Row)
        Else
            rws2.Range("Z" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = Trim(iws1.Range("Q" & Rng.Row) & " " & iws1.Range("R" & Rng.Row))
        End If
        rws2.Range("AA" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("S" & Rng.Row)
        rws2.Range("AB" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("T" & Rng.Row)
        rws2.Range("AC" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("U" & Rng.Row)
        rws2.Range("AD" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("V" & Rng.Row)
        rws2.Range("AE" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("W" & Rng.Row)
    End If
Next
RngList.RemoveAll
Workbooks("Pending_Import").Close
Application.ScreenUpdating = True
End Sub

Thoughts?
 
Upvote 0
Replace the corresponding lines of code with these lines: (Untested)
Code: 
For Each Rng In rws2.Range("C2", rws2.Range("C" & rws2.Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value & Rng.Offset(0, 3) & Rng.Offset(0, 9)) Then
            RngList.Add Rng.Value & Rng.Offset(0, 3) & Rng.Offset(0, 9), Nothing
        End If
Next

For Each Rng In iws1.Range("A2", iws1.Range("A" & iws1.Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value & Rng.Offset(0, 2) & Rng.Offset(0, 4)) Then
 
Upvote 0
That appears to be working! Thank you! This code comes in quite handy!!!
 
Upvote 0
Ok @mumps ...new problem. The first 2 records in the source workbook don't have values in column L. So, when I transfer them over to the destination workbook, they come over blank...that's fine. When it gets to the 3rd record, there is a value in column L, but it's being placed in row 2 on the destination workbook. I suspect the issue is that the current code is looking for the first null cell in the destination column, so I tried to adjust the code using LastRow+1, but it's not working. Thoughts?

Current code:

Code: 
        rws2.Range("T" & rws2.Rows.Count).End(xlUp).Offset(1, 0) = iws1.Range("L" & Rng.Row)

Tried these, but they didn't work, as in it only maps over 1 record:
Code: 
rLR2 = rws2.Range("C" & Rows.Count).End(xlUp).Row
Code: 
        rws2.Range("T" & rLR2).Offset(1, 0) = iws1.Range("L" & Rng.Row)
Code: 
        rws2.Range("T" & rLR2+1) = iws1.Range("L" & Rng.Row)
 
Upvote 0
Try:
Code: 
Private Sub cmd_Import_Click()
    Application.ScreenUpdating = False
    Dim r, i As Workbook
    Dim rws2, iws1 As Worksheet
    Dim Rng As Range
    Dim RngList As Object
    Dim rLR2 As Long
    Dim x As Long
    x = 2
    Set r = ThisWorkbook
    Set rws2 = ThisWorkbook.Sheets("Consolidated")
    Set RngList = CreateObject("Scripting.Dictionary")
    Set i = Workbooks.Open("\\Path")
    Set iws1 = i.Sheets("Data")
    For Each Rng In rws2.Range("C2", rws2.Range("C" & rws2.Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value & Rng.Offset(0, 3) & Rng.Offset(0, 9)) Then
            RngList.Add Rng.Value & Rng.Offset(0, 3) & Rng.Offset(0, 9), Nothing
        End If
    Next Rng
    For Each Rng In iws1.Range("A2", iws1.Range("A" & iws1.Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value & Rng.Offset(0, 2) & Rng.Offset(0, 4)) Then
            rws2.Range("C" & x) = iws1.Range("A" & Rng.Row)
            rws2.Range("D" & x) = iws1.Range("B" & Rng.Row)
            rws2.Range("F" & x) = iws1.Range("C" & Rng.Row)
            rws2.Range("J" & x) = iws1.Range("D" & Rng.Row)
            rws2.Range("L" & x) = iws1.Range("E" & Rng.Row)
            rws2.Range("M" & x) = iws1.Range("F" & Rng.Row)
            rws2.Range("N" & x) = iws1.Range("G" & Rng.Row)
            rws2.Range("O" & x) = iws1.Range("H" & Rng.Row)
            rws2.Range("P" & x) = iws1.Range("I" & Rng.Row)
            rws2.Range("Q" & x) = iws1.Range("J" & Rng.Row)
            rws2.Range("S" & x) = iws1.Range("K" & Rng.Row)
            rws2.Range("T" & x) = iws1.Range("L" & Rng.Row)
            rws2.Range("U" & x) = iws1.Range("M" & Rng.Row)
            rws2.Range("V" & x) = iws1.Range("N" & Rng.Row)
            rws2.Range("W" & x) = iws1.Range("O" & Rng.Row)
            rws2.Range("Y" & x) = iws1.Range("P" & Rng.Row)
            If iws1.Range("Q" & Rng.Row) = "" Then
                rws2.Range("Z" & x) = iws1.Range("R" & Rng.Row)
            Else
                rws2.Range("Z" & x) = Trim(iws1.Range("Q" & Rng.Row) & " " & iws1.Range("R" & Rng.Row))
            End If
            rws2.Range("AA" & x) = iws1.Range("S" & Rng.Row)
            rws2.Range("AB" & x) = iws1.Range("T" & Rng.Row)
            rws2.Range("AC" & x) = iws1.Range("U" & Rng.Row)
            rws2.Range("AD" & x) = iws1.Range("V" & Rng.Row)
            rws2.Range("AE" & x) = iws1.Range("W" & Rng.Row)
        End If
        x = x + 1
    Next Rng
    RngList.RemoveAll
    Workbooks("Pending_Import").Close
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Filter column on text value if that value exists using VBA
Replies
7
Views
278
Peter_SSs
Peter_SSs
A
  • Question Question
Excel data from one sheet, copy cells from row i'm working on to excel 'form' based on cell value
Replies
2
Views
529
asiuol84
A
D
  • Question Question
Generating Reports in Word Using Data in Excel
Replies
1
Views
338
Dan_W
D
K
  • Solved
Previously working very complex VBA now stopped
Replies
7
Views
532
Alex Blakenburg
A
L
  • Question Question
VBA code for macro button not working to transfer row data to another worksheet
Replies
1
Views
297
rjwalker1973
R

Forum statistics

Threads
1,223,911
Messages
6,175,329
Members
452,635
Latest member
laura12345

Share this page

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