Comparing Multiple Criteria Across Two Worksheets to Find and Migrate Rows

reberryjr

Active Member
Joined
Mar 16, 2017
Messages
483
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
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,502
When you say "I would want to move record over" do you mean that you would want to move the entire row where the columns don't match to the first available row in the Working Population worksheet or do you want to copy the row?
 

reberryjr

Active Member
Joined
Mar 16, 2017
Messages
483
@mumps, I would want to copy the row. Once the comparison and data migration is complete, I'll just wind up deleting the "from" sheet.
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,502
This macro assumes that column A in Sheets("Incoming Volume") will always have data.
Code:
Sub CompareData()
    Application.ScreenUpdating = False
    Dim Rng As Range, RngList As Object
    Set RngList = CreateObject("Scripting.Dictionary")
    Sheets("Working Population").Select
    For Each Rng In Range("O2", Range("O" & Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value & Rng.Offset(0, 9)) Then
            RngList.Add Rng.Value & Rng.Offset(0, 9), Nothing
        End If
    Next
    Sheets("Incoming Volume").Select
    For Each Rng In Range("H2", Range("H" & Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value & Rng.Offset(0, 9)) Then
            Rng.EntireRow.Copy Sheets("Working Population").Cells(Sheets("Working Population").Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next
    RngList.RemoveAll
    Application.ScreenUpdating = True
End Sub
If you want the macro to delete the "Incoming Volume" sheet after the data migration is complete, add these lines of code:
Code:
Application.DisplayAlerts = False
Sheets("Incoming Volume").Delete
Application.DisplayAlerts = True
below this line:
Code:
RngList.RemoveAll
 
Last edited:

reberryjr

Active Member
Joined
Mar 16, 2017
Messages
483
@mumps, thank you for this. A couple of questions. It only appears to be evaluating the first row, not the entire sheet. Or, am I missing how it's evaluating everything?

Neither of the worksheets will consistently have data in column A. Instead, the Incoming Volume sheet will always have data in column H, and the Working Population sheet will always have data in column O.

Your code goes a different route than what I was contemplating, so I do have a question about the copy/paste. Essentially, where the record on the Incoming Volume sheet is unique, I'd need to copy range H : BB and paste it into range O & LastRow + 1 on the Working Population sheet.
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,502
Try:
Code:
Sub CompareData()
    Application.ScreenUpdating = False
    Dim Rng As Range, RngList As Object
    Set RngList = CreateObject("Scripting.Dictionary")
    Sheets("Working Population").Select
    For Each Rng In Range("O2", Range("O" & Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value & Rng.Offset(0, 9)) Then
            RngList.Add Rng.Value & Rng.Offset(0, 9), Nothing
        End If
    Next
    Sheets("Incoming Volume").Select
    For Each Rng In Range("H2", Range("H" & Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value & Rng.Offset(0, 9)) Then
            Range("H" & Rng.Row & ":BB" & Rng.Row).Copy Sheets("Working Population").Cells(Sheets("Working Population").Rows.Count, "O").End(xlUp).Offset(1, 0)
        End If
    Next
    RngList.RemoveAll
    Application.ScreenUpdating = True
End Sub
 

reberryjr

Active Member
Joined
Mar 16, 2017
Messages
483
@mumps, thank you so much! It works. I'm not entirely sure how all of it works just yet, but it works!
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,502
You are very welcome. :) Here is the code with some explanatory comments:
Code:
Sub CompareData()
    Application.ScreenUpdating = False
    Dim Rng As Range, RngList As Object
    Set RngList = CreateObject("Scripting.Dictionary") 'creates dictionary to store data
    Sheets("Working Population").Select
    For Each Rng In Range("O2", Range("O" & Rows.Count).End(xlUp)) 'loops through column O
        If Not RngList.Exists(Rng.Value & Rng.Offset(0, 9)) Then 'if the concatenated values of cells in column O and column X are not in dicitonary...
            RngList.Add Rng.Value & Rng.Offset(0, 9), Nothing 'adds the concatenated values of cells in column O and column X
        End If
    Next
    Sheets("Incoming Volume").Select
    For Each Rng In Range("H2", Range("H" & Rows.Count).End(xlUp)) 'loops through column H
        If Not RngList.Exists(Rng.Value & Rng.Offset(0, 9)) Then 'if the concatenated values of cells in column H and column Q are not in dicitonary, ie they are unique.....
            Range("H" & Rng.Row & ":BB" & Rng.Row).Copy Sheets("Working Population").Cells(Sheets("Working Population").Rows.Count, "O").End(xlUp).Offset(1, 0) 'copies range
        End If
    Next
    RngList.RemoveAll 'empties dictionary
    Application.ScreenUpdating = True
End Sub
 

reberryjr

Active Member
Joined
Mar 16, 2017
Messages
483
@mumps, I need some help again. There were some changes made to the workbooks and the ask, but the theory is the same. Now, I need to find the unique records on a workbook called "BKR417" (instead of a sheet in the same workbook). Paste the differences in the first available cell in column R of the receiving workbook. I tried adapting the code above, but nothing is pasting, and I'm not getting any errors. When I step through the code, it seems to hit the lines in red font, but only cycles through Ln 27 - Ln 30, with no action being taken.

Thoughts?

Code:
Sub IngestIncomingVolume()
Application.ScreenUpdating = False
Dim iVol, mVol As Workbook
Dim iws2, mws2 As Worksheet
Dim Rng As Range
Dim RngList As Object
Set mVol = ThisWorkbook
Set mws2 = ThisWorkbook.Sheets("Active_Inv")
Set iRngList = CreateObject("Scripting.Dictionary")
On Error Resume Next
Set iVol = Workbooks.Open("FilePath is Here")
Set iws2 = iVol.Sheets("New Notification OD Detail")

Workbooks("DepApp v1").Activate
Sheets("Active_Inv").Select
For Each Rng In Range("R2", Range("R" & Rows.Count).End(xlUp))
    If Not RngList.exists(Rng.Value & Rng.Offset(0, 9)) Then
        RngList.Add Rng.Value & Rng.Offset(0, 9), Nothing
    End If

Next

Workbooks("BKR417").Activate
Sheets("New Notification OD Detail").Select
For Each Rng In Range("H2", Range("H" & Rows.Count).End(xlUp))
[COLOR=#FF0000]    If Not RngList.exists(Rng.Value & Rng.Offset(0, 9)) Then
        Range("H" & Rng.Row & ":BB" & Rng.Row).Copy Workbooks("DepApp v1").Sheets("Active_Inv").Cells(Sheets("Active_Inv").Rows.Count, "R").End(xlUp).Offset(1, 0)
    End If[/COLOR]
Next
    
RngList.RemoveAll
Application.ScreenUpdating = True
End Sub
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,502
I tidied up the code a bit. See if this works for you:
Code:
Sub IngestIncomingVolume()
    Application.ScreenUpdating = False
    Dim iVol As Workbook, mVol As Workbook
    Dim iws2 As Worksheet, mws2 As Worksheet
    Dim Rng As Range
    Dim RngList As Object
    Set mVol = ThisWorkbook
    Set mws2 = ThisWorkbook.Sheets("Active_Inv")
    Set iRngList = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    Set iVol = Workbooks.Open("FilePath is Here")
    Set iws2 = iVol.Sheets("New Notification OD Detail")
    For Each Rng In mws2.Range("R2", mws2.Range("R" & mws2.Rows.Count).End(xlUp))
        If Not RngList.exists(Rng.Value & Rng.Offset(0, 9)) Then
            RngList.Add Rng.Value & Rng.Offset(0, 9), Nothing
        End If
    Next
    For Each Rng In iws2.Range("H2", iws2.Range("H" & iws2.Rows.Count).End(xlUp))
        If Not RngList.exists(Rng.Value & Rng.Offset(0, 9)) Then
            iws2.Range("H" & Rng.Row & ":BB" & Rng.Row).Copy mws2.Cells(mws2.Rows.Count, "R").End(xlUp).Offset(1, 0)
        End If
    Next
    RngList.RemoveAll
    Application.ScreenUpdating = True
End Sub
 

Forum statistics

Threads
1,081,420
Messages
5,358,574
Members
400,504
Latest member
RedSquirrel

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top