compare two different worksheets using dictionary

reggieneo

New Member
Joined
Jun 27, 2017
Messages
18
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
1
ID
Name
S/N
WO#
Description
2
12345
Harry
1
33221
Repair
3
45678
Leo
1
44532
Delivery
4
91012
Bert
1
23432
Paint
5
35555
Bert
1
35555
Admin Works

<tbody>
</tbody>
Sheet2
1
ID
Name
S/N
WO#
Description
2
12345
Harry
1
33221
Repair
3
45678
Leo
1
44532
Delivery
4
91012
Bert
1
23432
Paint
5

<tbody>
</tbody>
 

Some videos you may like

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
2,843
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
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
 

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,684
Office Version
  1. 365
Platform
  1. Windows
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:

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
46,227
Office Version
  1. 365
Platform
  1. Windows
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:

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,684
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

@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:

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
46,227
Office Version
  1. 365
Platform
  1. Windows
.. 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
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
 

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,684
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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?
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
46,227
Office Version
  1. 365
Platform
  1. Windows
Still unsure how your code is comparing col A and col B to test unique keys,
It's not, it's comparing column A & D. Perhaps yours is testing the wrong columns?

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
1
ID
Name
S/N
WO#
Description
2
12345
Harry
1
33221
Repair
3
45678
Leo
1
44532
Delivery
4
91012
Bert
1
23432
Paint
5
35555
Bert
1
35555
Admin Works

<tbody>
</tbody>
Sheet2
1
ID
Name
S/N
WO#
Description
2
12345
Harry
1
33221
Repair
3
45678
Leo
1
44532
Delivery
4
91012
Bert
1
23432
Paint
5

<tbody>
</tbody>

Rich (BB code):
    .Range("BZ2").Formula = Replace(Replace("=COUNTIFS('#'!A$1:A$%,A2,'#'!D$1:D$%,D2)=0", "#", ws2.Name), "%", nr - 1)
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:

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,684
Office Version
  1. 365
Platform
  1. Windows
I wrongly was comparing column A and B, you're right, it's D and now formula makes sense. Thanks for the explanations :)
 

Watch MrExcel Video

Forum statistics

Threads
1,108,973
Messages
5,525,984
Members
409,673
Latest member
Riseee

This Week's Hot Topics

Top