compare two different worksheets using dictionary

R

reggieneo

New Member
Joined
Jun 27, 2017
Messages
26
Hi All, my head is spinning now on this and I can't figure out how to accurately compare 2 sheets of 2 columns. What I would like to do is, IF ID and WO# in Sheet1 is not found in Sheet2 then the entire row (has 52 columns) that has the new sets of ID and WO# be copied to the next blank row in Sheet2. it needs to resize up to the column AZ . in the table below, the result should be row 5, entire row up to column AZ in Sheet1 must be also in Sheet2. Appreciate if this can be done in Vba. Thanks so much . Sheet1 [TABLE="width: 500"]
<tbody>[TR]
[TD]1
[/TD]
[TD]ID
[/TD]
[TD]Name
[/TD]
[TD]S/N
[/TD]
[TD]WO#
[/TD]
[TD]Description
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]12345
[/TD]
[TD]Harry
[/TD]
[TD]1
[/TD]
[TD]33221
[/TD]
[TD]Repair
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]45678
[/TD]
[TD]Leo
[/TD]
[TD]1
[/TD]
[TD]44532
[/TD]
[TD]Delivery
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]91012
[/TD]
[TD]Bert
[/TD]
[TD]1
[/TD]
[TD]23432
[/TD]
[TD]Paint
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]35555
[/TD]
[TD]Bert
[/TD]
[TD]1
[/TD]
[TD]35555
[/TD]
[TD]Admin Works
[/TD]
[/TR]
</tbody>[/TABLE]
Sheet2 [TABLE="width: 500"]
<tbody>[TR]
[TD]1
[/TD]
[TD]ID
[/TD]
[TD]Name
[/TD]
[TD]S/N
[/TD]
[TD]WO#
[/TD]
[TD]Description
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]12345
[/TD]
[TD]Harry
[/TD]
[TD]1
[/TD]
[TD]33221
[/TD]
[TD]Repair
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]45678
[/TD]
[TD]Leo
[/TD]
[TD]1
[/TD]
[TD]44532
[/TD]
[TD]Delivery
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]91012
[/TD]
[TD]Bert
[/TD]
[TD]1
[/TD]
[TD]23432
[/TD]
[TD]Paint
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Sort by date Sort by votes
Let me know if this works for you...

Code: 
Sub MoveRows()
Dim ws1     As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2     As Worksheet: Set ws2 = Sheets("Sheet2")
Dim AR1()   As Variant: AR1 = ws1.Range("A1").CurrentRegion.Value
Dim AR2()   As Variant: AR2 = ws2.Range("A1").CurrentRegion.Value
Dim Dict    As Object: Set Dict = CreateObject("Scripting.Dictionary")
Dim LR      As Long
Dim Tmp()   As Variant
Dim R       As Range


With Dict
    For i = 2 To UBound(AR2)
        If Not .exists(AR2(i, 2) & "-" & AR2(i, 4)) Then
            .Add AR2(i, 2) & "-" & AR2(i, 4), Nothing
        End If
    Next i


    For i = 2 To UBound(AR1)
        If Not .exists(AR1(i, 2) & "-" & AR1(i, 4)) Then
            Tmp = Application.Index(AR1, i, 0)
            LR = ws2.Range("A" & Rows.Count).End(xlUp).Row() + 1
            Set R = ws2.Range("A" & LR).Resize(1, UBound(Tmp))
            R.Value = Tmp
        End If
    Next i
End With


End Sub
 
Upvote 0
Another suggestion:
Code: 
Sub M1()

    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    Dim r   As Range
    Dim v() As Variant
    Dim x   As Long
    Dim y   As Long
    
    With sheets("Sheet2")
        y = Application.Max(52, .Cells(1, .Columns.Count).End(xlToLeft).Column)
        v = .Cells(2, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, 2).Value
    End With
    
    For x = LBound(v, 1) To UBound(v, 1)
        dic(v(x, 1) & "|" & v(x, 2)) = x + 1
    Next x
    
    With sheets("Sheet1")
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        v = .Cells(2, 1).Resize(x, 2).Value
        Set r = .Cells(x + 1, 1)
        For x = LBound(v, 1) To UBound(v, 1)
            If Not dic.exists(v(x, 1) & "|" & v(x, 2)) Then Set r = Union(r, sheets("Sheet1").Cells(x + 1, 1).Resize(, y))
        Next x
    End With
    
    With sheets("Sheet2")
        x = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(x, 1).Resize(r.Rows.Count, r.Columns.Count).Value = r.Value
    End With
    
    Erase v
    Set dic = Nothing
    Set r = Nothing
    
End Sub
 
Last edited:
Upvote 0
This doesn't use the dictionary you mentioned and may struggle if your data is very large but on the other hand should copy all the required rows at once.
Test with a copy of your workbook.
Edit: Assumption with my code is that all rows have a value in column A

(Interested to know about how many rows of data you do have as the best/fastest method may be different)

Code: 
Sub UpdateRows()
  Dim ws1 As Worksheet, ws2 As Worksheet
  Dim nr As Long
  
  Set ws1 = Sheets("Sheet1"): Set ws2 = Sheets("Sheet2")
  nr = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row + 1
  With ws1
    .Range("BZ2").Formula = Replace(Replace("=COUNTIFS('#'!A$1:A$%,A2,'#'!D$1:D$%,D2)=0", "#", ws2.Name), "%", nr - 1)
    .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 52).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("BZ1:BZ2"), CopyToRange:=ws2.Cells(nr, 1), Unique:=False
    .Range("BZ2").ClearContents
  End With
  ws2.Rows(nr).Delete
End Sub
 
Last edited:
Upvote 0
@Peter_SSs Hi, like the code (short and use of .AdvancedFilter) but using the OP's data example appled to Sheet1 (A2:E5) and Sheet2 (A2:E4), Sheet2 doesn't update with the row from Sheet1 (35555 Bert).

Also unsure how it's comparing a unique key of Col A and Col B across the two sheets?

I went with the range union option in mine to minimize read/writes
 
Last edited:
Upvote 0
JackDanIce said:
.. but using the OP's data example appled to Sheet1 (A2:E5) and Sheet2 (A2:E4), Sheet2 doesn't update with the row from Sheet1
Click to expand...
The OP said the data extended to column AZ. I made the assumption that those columns would also have headings. Try my code again after adding some headings to those columns in Sheet1
 
Upvote 0
Beat me to it, yes headers missing, now works, thanks!

Still unsure how your code is comparing col A and col B to test unique keys, or at least what the COUNTIFs is testing, do you mind expanding on that please?
 
Upvote 0
JackDanIce said:
Still unsure how your code is comparing col A and col B to test unique keys,
Click to expand...
It's not, it's comparing column A & D. Perhaps yours is testing the wrong columns?

reggieneo said:
IF ID and WO# in Sheet1 is not found in Sheet2 then the entire row (has 52 columns) that has the new sets of ID and WO# be copied to the next blank row in Sheet2. it needs to resize up to the column AZ . in the table below, the result should be row 5, entire row up to column AZ in Sheet1 must be also in Sheet2. Appreciate if this can be done in Vba. Thanks so much . Sheet1 [TABLE="width: 500"]
<tbody>[TR]
[TD]1
[/TD]
[TD]ID
[/TD]
[TD]Name
[/TD]
[TD]S/N
[/TD]
[TD]WO#
[/TD]
[TD]Description
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]12345
[/TD]
[TD]Harry
[/TD]
[TD]1
[/TD]
[TD]33221
[/TD]
[TD]Repair
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]45678
[/TD]
[TD]Leo
[/TD]
[TD]1
[/TD]
[TD]44532
[/TD]
[TD]Delivery
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]91012
[/TD]
[TD]Bert
[/TD]
[TD]1
[/TD]
[TD]23432
[/TD]
[TD]Paint
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]35555
[/TD]
[TD]Bert
[/TD]
[TD]1
[/TD]
[TD]35555
[/TD]
[TD]Admin Works
[/TD]
[/TR]
</tbody>[/TABLE]
Sheet2 [TABLE="width: 500"]
<tbody>[TR]
[TD]1
[/TD]
[TD]ID
[/TD]
[TD]Name
[/TD]
[TD]S/N
[/TD]
[TD]WO#
[/TD]
[TD]Description
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]12345
[/TD]
[TD]Harry
[/TD]
[TD]1
[/TD]
[TD]33221
[/TD]
[TD]Repair
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]45678
[/TD]
[TD]Leo
[/TD]
[TD]1
[/TD]
[TD]44532
[/TD]
[TD]Delivery
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]91012
[/TD]
[TD]Bert
[/TD]
[TD]1
[/TD]
[TD]23432
[/TD]
[TD]Paint
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
Click to expand...

Peter_SSs said:
Rich (BB code): 
    .Range("BZ2").Formula = Replace(Replace("=COUNTIFS('#'!A$1:A$%,A2,'#'!D$1:D$%,D2)=0", "#", ws2.Name), "%", nr - 1)
Click to expand...
The COUNTIFS is returning TRUE if the count of col A & col D in Sheet1 values in Sheet2 is zero - meaning that row needs to be copied with the Adv Filter
 
Last edited:
Upvote 0
I wrongly was comparing column A and B, you're right, it's D and now formula makes sense. Thanks for the explanations :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
VBA to Insert Mismatched Row in separate worksheet
2 3
Replies
21
Views
755
Peter_SSs
Peter_SSs
M
  • Solved
Comparing two columns on different sheets and deleting the entire row if any cell is different
Replies
9
Views
349
Logit
Logit
J
  • Solved
VBA to compare rows in two different sheets, if match highlight cell
2
Replies
11
Views
2K
DaveB673
DaveB673
C
  • Solved
VBA to Compare two different worksheets and copy missing rows
2
Replies
10
Views
5K
cscotty
C
C
  • Solved
Compare two sheets using one column as reference and display difference - Using dictionary method
2
Replies
10
Views
1K
jskasango
jskasango

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

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