modified code compare all differences between two sheets

[MKLAQ]

hello
I got this code is very well , but the problem it shows only the data are existed in sheet1 and is not existed in sheet2 I would also shows data what is existed in sheet2 but is not existed in sheet1

Sub NewEntry()
    Dim OldDict As Object, arrIn As Variant, arrOld As Variant, arrNew() As Variant, a As Long, r As Long
    Set OldDict = CreateObject("Scripting.Dictionary")
    arrIn = sheet1.Range("A1:c6").Value
    arrOld = sheet2.Range("A1:c6").Value
'prior values
    With OldDict
         .CompareMode = vbTextCompare
        For a = 1 To UBound(arrOld)
            If Not .Exists(arrOld(a, 1)) Then OldDict.Add arrOld(a, 1), arrOld(a, 1)
        Next a
'get new values
        ReDim arrNew(1 To UBound(arrIn), 1 To 3)
        For a = 1 To UBound(arrIn)
            If Not .Exists(arrIn(a, 1)) Then
                r = r + 1
                arrNew(r, 1) = arrIn(a, 1)
                arrNew(r, 2) = arrIn(a, 2)
                arrNew(r, 3) = arrIn(a, 3)
                
            End If
        Next a
    End With
'write to sheet
    sheet3.Range("a2").Resize(UBound(arrIn), 3).Value = arrNew
End Sub

 

[Peter_SSs]

There may be a more efficient way but here I quickly repeated the process the other way around. See if it does what you want.

Sub NewEntry()
    Dim OldDict As Object, arrIn As Variant, arrOld As Variant, arrNew() As Variant, a As Long, r As Long
    Set OldDict = CreateObject("Scripting.Dictionary")
    arrIn = Sheet1.Range("A1:c6").Value
    arrOld = Sheet2.Range("A1:c6").Value
'prior values
    With OldDict
         .CompareMode = vbTextCompare
        For a = 1 To UBound(arrOld)
            If Not .Exists(arrOld(a, 1)) Then OldDict.Add arrOld(a, 1), arrOld(a, 1)
        Next a
'get new values
        ReDim arrNew(1 To UBound(arrIn), 1 To 3)
        For a = 1 To UBound(arrIn)
            If Not .Exists(arrIn(a, 1)) Then
                r = r + 1
                arrNew(r, 1) = arrIn(a, 1)
                arrNew(r, 2) = arrIn(a, 2)
                arrNew(r, 3) = arrIn(a, 3)
                
            End If
        Next a
    End With
'write to sheet
    Sheet3.Range("a2").Resize(UBound(arrIn), 3).Value = arrNew

'reset values
OldDict.RemoveAll
r = 0

'read data from opposite sheets
    arrIn = Sheet2.Range("A1:c6").Value
    arrOld = Sheet1.Range("A1:c6").Value
'prior values
    With OldDict

        For a = 1 To UBound(arrOld)
            If Not .Exists(arrOld(a, 1)) Then OldDict.Add arrOld(a, 1), arrOld(a, 1)
        Next a
'get new values
        ReDim arrNew(1 To UBound(arrIn), 1 To 3)
        For a = 1 To UBound(arrIn)
            If Not .Exists(arrIn(a, 1)) Then
                r = r + 1
                arrNew(r, 1) = arrIn(a, 1)
                arrNew(r, 2) = arrIn(a, 2)
                arrNew(r, 3) = arrIn(a, 3)
                
            End If
        Next a
    End With
'write to sheet
    Sheet3.Range("E2").Resize(UBound(arrIn), 3).Value = arrNew
    
End Sub

 

[MKLAQ]

thanks for mod the code but honestly doesn't work well it copy some data from a:c and some data copy from e:f it supposes all data froma2: c so when you have time please fixing and if is possible would you make the code is short not long
thanks

 

[Peter_SSs]

The code I added did the exact same thing as the code you already posted but with the sheets reversed and put the second set of results in columns E:G of Sheet3. If that is not what you want then you would need to show me what you do want by posting small samples of data for the two sheets and the expected results with XL2BB

 

[MKLAQ]

Hi peter!
i put the result in sheet result in short words it should show all the difference between two sheets
sheet1

ID	NAME	PART
ASD1231233978	Alan	A
ASC1234347788	Sarah	B
ASX1789760TTT	Rberto	C
ASD-12344-1233-AS	kathrin	D
ASZXCFSDHFFHF	kane	E

sheet2

ID	NAME	PART
ASX1789760TTT	Rberto	C
ASD-12344-1233-AS	kathrin	D
GHF-12233334	Lock	F
ZXC/12333-1233	Lina	G
ZXCCCCASDDW	nick	H
ASZXCFSDHFFHF	kane	E

result

ID	NAME	PART
ASD1231233978	Alan	A
ASC1234347788	Sarah	B
GHF-12233334	Lock	F
ZXC/12333-1233	Lina	G
ZXCCCCASDDW	nick	H

 

[Peter_SSs]

Thanks for the sample data and results. It seems there are two issues why my code did did not do exactly what you wanted.

1. You had not shown the desired results altogether from both sheets and my code put them in two lots of 3 columns.
2. The original code that you said worked well only looked at the range A1:C6 on both sheets. Your sample data uses 7 rows in Sheet2.

So, to accommodate any number of rows of sample data, and putting all results in the same 3 columns, try this version.

Sub NewEntry_v2()
    Dim OldDict As Object, arrIn As Variant, arrOld As Variant, arrNew() As Variant, a As Long, r As Long
    
    Set OldDict = CreateObject("Scripting.Dictionary")
    
'read data into arrays
    arrIn = Sheet1.Range("A1", Sheet1.Range("C" & Rows.Count).End(xlUp)).Value
    arrOld = Sheet2.Range("A1", Sheet2.Range("C" & Rows.Count).End(xlUp)).Value
'prior values
    With OldDict
         .CompareMode = vbTextCompare
        For a = 1 To UBound(arrOld)
            If Not .Exists(arrOld(a, 1)) Then OldDict.Add arrOld(a, 1), arrOld(a, 1)
        Next a
'get new values
        ReDim arrNew(1 To UBound(arrIn), 1 To 3)
        For a = 1 To UBound(arrIn)
            If Not .Exists(arrIn(a, 1)) Then
                r = r + 1
                arrNew(r, 1) = arrIn(a, 1)
                arrNew(r, 2) = arrIn(a, 2)
                arrNew(r, 3) = arrIn(a, 3)
                
            End If
        Next a
    End With
'write to sheet
    Sheet3.Range("A2").Resize(UBound(arrIn), 3).Value = arrNew

'reset values
OldDict.RemoveAll
r = 0

'read data from opposite sheets
    arrIn = Sheet2.Range("A1", Sheet2.Range("C" & Rows.Count).End(xlUp)).Value
    arrOld = Sheet1.Range("A1", Sheet1.Range("C" & Rows.Count).End(xlUp)).Value
'prior values
    With OldDict

        For a = 1 To UBound(arrOld)
            If Not .Exists(arrOld(a, 1)) Then OldDict.Add arrOld(a, 1), arrOld(a, 1)
        Next a
'get new values
        ReDim arrNew(1 To UBound(arrIn), 1 To 3)
        For a = 1 To UBound(arrIn)
            If Not .Exists(arrIn(a, 1)) Then
                r = r + 1
                arrNew(r, 1) = arrIn(a, 1)
                arrNew(r, 2) = arrIn(a, 2)
                arrNew(r, 3) = arrIn(a, 3)
                
            End If
        Next a
    End With
'write to sheet
    Sheet3.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(arrIn), 3).Value = arrNew
    
End Sub

 

[MKLAQ]

great updating ! sorry if I make confusing and I'm not clear what I would
many thanks for your assistance

 

[Peter_SSs]

You're welcome.

Yes, clarity is important as your understand what you have and what you want but we only know what you show or tell us.