Macro I was given dont seem to be doing what it originally supposed to do.

[ghrek]

Hi

I was given this macro and it dont seem to be doing what I want it to do anymore. What im trying to do is compare data in sheets 1 &2 and if matching entries I need them deleting from both sheets.

It should then mark on sheet 1 missing or sheet 2 duplicate if it is the case.

It seems to do it for some cells but others doing nothing, Could someone possibly have a look and advise as dont know where to start.

Big thanks in advance

Option Explicit

Sub DeleteIdenticalRecordsFromTwoSheets()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lr1 As Long, lr2 As Long, i As Long
Dim x, y, xx(), yy(), dict1, dict2
Dim delRng1 As Range, delRng2 As Range

Application.ScreenUpdating = False

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

lr1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row

ws1.Range("A1:D" & lr1).RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlNo

lr1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
x = ws1.Range("A1:D" & lr1).Value
y = ws2.Range("A1:D" & lr2).Value

Set dict1 = CreateObject("Scripting.Dictionary")
Set dict2 = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(x, 1)
    dict1.Item(x(i, 1) & x(i, 2) & x(i, 3) & x(i, 4)) = ws1.Range("A" & i).Address
Next i

For i = 1 To UBound(y, 1)
    dict2.Item(y(i, 1) & y(i, 2) & y(i, 3) & y(i, 4)) = ws2.Range("A" & i).Address
Next i

ws1.Columns("E").Clear
ws2.Columns("E").Clear

For i = 1 To UBound(x, 1)
    If dict2.exists(x(i, 1) & x(i, 2) & x(i, 3) & x(i, 4)) Then
        If delRng1 Is Nothing Then
            Set delRng1 = ws1.Range(dict1.Item(x(i, 1) & x(i, 2) & x(i, 3) & x(i, 4)))
        Else
            Set delRng1 = Union(delRng1, ws1.Range(dict1.Item(x(i, 1) & x(i, 2) & x(i, 3) & x(i, 4))))
        End If
    Else
        ws1.Cells(i, 5) = "Missing"
    End If
Next i

For i = 1 To UBound(y, 1)
    If dict1.exists(y(i, 1) & y(i, 2) & y(i, 3) & y(i, 4)) Then
        If delRng2 Is Nothing Then
            Set delRng2 = ws2.Range(dict2.Item(y(i, 1) & y(i, 2) & y(i, 3) & y(i, 4)))
        Else
            Set delRng2 = Union(delRng2, ws2.Range(dict2.Item(y(i, 1) & y(i, 2) & y(i, 3) & y(i, 4))))
        End If
    End If
Next i


If Not delRng1 Is Nothing Then delRng1.EntireRow.Delete
If Not delRng2 Is Nothing Then delRng2.EntireRow.Delete

lr2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row

y = ws2.Range("A1:D" & lr2).Value

For i = 1 To UBound(y, 1)
    If dict1.exists(y(i, 1) & y(i, 2) & y(i, 3) & y(i, 4)) Then
        ws2.Range("E" & i).Value = "Duplicate"
    End If
Next i

Application.ScreenUpdating = True
End Sub

 

[ghrek]

Hi

Sorry to be a pain but I cant seem to get it to work and it doing my head in. In the enclosed workbook Im using (attached) on sheet 2 there is more value than whats on sheet 1.

What you would think that sheet 2 has duplicated data of which is one reason why but also there could be data in sheet 2 that is not in sheet 1 causing the difference too.
There are occasions that sometimes there are duplicated entries on sheet 2 but they are not duplicated as there are 2 entries on sheet 1 too

Im trying to get a macro that leaves all the entries that are on sheet 2 as duplicated or not on sheet 1 listed.

PERIOD END ISSING SHIFTS (1).xlsb

Workbook has the macro in it thats been previously posted on here.

Thanks

 

[Fluff]

Cross posted.
Please supply the link(s)

 

[ghrek]

Sorry but I donno where as the workbook is in the post I done a few days ago on here

 

[Fluff]

You asked this question on at least one other site & therefore need to supply the relevant link(s)
You already know this as you have been picked up on it before.

 

[ghrek]

OK thought cos I had already put link in further back didnt think needed to do again but there goes

How do I look for missing /duplicated data and delete matching data.

 

[Fluff]

That link is for the old thread, you have started a more recent one, with your latest problem. You have also had an answer there which you have not replied to.

 

[ghrek]

Sorry it was late night and forgot about it but here goes Delete matching records but some duplicated.

 

[Fluff]

Thanks for that.
Unfortunately I do not understand what you are after. There will never be a duplicates on sheet1, because your code deletes them.

 

[ghrek]

There will never be duplicates on sheet 1 but there may be data that is missing from sheet 2 that should still be in there

 

[Fluff]

Sorry but you are not making any sense. You said that items on sheet 2 are being marked as duplicates, which shouldn't be, because there are 2 entries on sheet1.
How can that be true when you delete duplicate entries on sheet1?