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

 

[Fluff]

Not sure I understand, there will never be any duplicates, because you are deleting them.

 

[ghrek]

Sorry didnt explain properly. In sheet 1 it a download and in sheet 2 its manually input data. What I meant by duplicated was that sometimes people input data manually twice when it should only be in once as should match with download. Hope that helps.

 

[Fluff]

Hope that helps.

Nope, that's about as clear as mud.
The last part of your code is checking if the data in sheet2 matches sheet1 & if it does then flag it as duplicate. But you have already deleted the duplicate rows, so it's not doing anything.

 

[ghrek]

Thats where I think the issue is..

What should happen is if the data in sheet 2 matches the data in sheet 1 across all columns in a particular row then I need the row deleting from sheets 1 & 2

If the data is in sheet 1 but NOT sheet 2 then I need it marking up as MISSING on sheet 1
If the data is in sheet 2 but NOT in sheet 1 then I need it marking up as MISSING FROM TABLEAU on sheet 2
If there is a duplicated entry on sheet 2 then I need them marking up as DUPLICATE but dont delete any duplicates.

 

[Fluff]

OK, that's clearer.
But I think that you have forgotten something in the form of a link

 

[ghrek]

Donno if this will work but here goes

compare missing shifts monday (4) (7).xlsm

 

[Fluff]

I was actually refering to the fact that you have cross posted.

 

[ghrek]

sorry I had put on other website but didnt think yours as originally on here.

here goes

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

 

[Fluff]

Thank you.

Just want to check what the point is of adding missing or missing in tableau is. As I understand it, the only data left will be the stuff that is missing.