Hi

I have this macro that points out "MISSING" and "DUPLICATE". Its good but I have an issue where there is more than one entry the same on both worksheets. Although these are duplicate entries they are not as there are exact matching entries on both sheets. The defention of duplicate is if there is more than one entry on sheet called "WFD" and only one entry on sheet called "TAB"


Is there anyway you can add to this macro and look through the sheet called "sheet 3 " for entries marked DUPLICATE and then look through the tabs marked "TAB" and "WFD" again to see if there is more than one matching entry on BOTH sheets and if there is delete the entry from sheet 3?

Sub list_duplicated_missing_entries()
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
  Dim dicW As Object, dicT As Object, ky As Variant, cad As Variant
  Dim a() As Variant, b() As Variant, c() As Variant, i As Long, n As Long
 
  Set sh1 = Sheets("TAB")
  Set sh2 = Sheets("WFD")
  Set sh3 = Sheets("Sheet3")
 
  a = sh1.Range("A1:D" & sh1.Range("A" & Rows.Count).End(xlUp).Row).Value2
  b = sh2.Range("A1:D" & sh2.Range("A" & Rows.Count).End(xlUp).Row).Value2
  ReDim c(1 To (UBound(a) + UBound(b)), 1 To 6)
  sh3.Range("A3:F" & Rows.Count).ClearContents
  n = 1
  'load TAB
  Set dicT = CreateObject("scripting.dictionary")
  For i = 1 To UBound(a, 1)
    dicT(a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) & "|" & a(i, 4)) = Empty
  Next
  'load WFD
  Set dicW = CreateObject("scripting.dictionary")
  For i = 1 To UBound(b, 1)
    If dicW.exists(b(i, 1) & "|" & b(i, 2) & "|" & b(i, 3) & "|" & b(i, 4)) Then
      c(n, 1) = b(i, 1)
      c(n, 2) = b(i, 2)
      c(n, 3) = b(i, 3)
      c(n, 4) = b(i, 4)
      c(n, 5) = Empty
      c(n, 6) = "DUPLICATE"
      n = n + 1
    Else
      dicW(b(i, 1) & "|" & b(i, 2) & "|" & b(i, 3) & "|" & b(i, 4)) = Empty
    End If
  Next
  'If there is data in sheet called "TAB" but not in sheet called "WFD"
  For Each ky In dicT.keys
    If Not dicW.exists(ky) Then
      cad = Split(ky, "|")
      c(n, 1) = cad(0)
      c(n, 2) = cad(1)
      c(n, 3) = cad(2)
      c(n, 4) = cad(3)
      c(n, 5) = Empty
      c(n, 6) = "MISSING FROM WFD"
      n = n + 1
    End If
  Next
  'If there is data in sheet called "WFD" but not in sheet called "TAB"
  For Each ky In dicW.keys
    If Not dicT.exists(ky) Then
      cad = Split(ky, "|")
      c(n, 1) = cad(0)
      c(n, 2) = cad(1)
      c(n, 3) = cad(2)
      c(n, 4) = cad(3)
      c(n, 5) = Empty
      c(n, 6) = "NOT IN TAB"
      n = n + 1
    End If
  Next
  sh3.Range("A1").Resize(n, 6).Value = c()
  MsgBox "Done"
End Sub