How do I list duplicated and missing entries on a seperate sheet.

[ghrek]

Hi

I have a workbook that has data in 2 sheets called "TAB" and "WFD" .

What im trying to do is compare the 2 workbooks and look for missing data and also duplicated issues. Both sheets have data in columns A-D but is spread all over the worksheet. I.E lets say in sheet called "TAB" there is in row 4

1022​

405​

06/11/2019​

£27.10​

and then the same data may be in any row of sheet called WFD.

What im trying to do is it to look on sheet called "TAB" starting at row 3 and then look down the sheet called "WFD" for an exact match. If there is an exact match then nothing needs to be done. I then need this to repeat looking and matching data until the last entry in the workbook.

I then have the following situations that I need to look at:-

1 )If there is data in the sheet called "TAB" but not in sheet called "WFD" I then need the data in the row concerned copied and pasted into sheet 3 and in column F mark it as "MISSING FROM WFD"
2) If there is data in sheet called "WFD" but not in sheet called "TAB" I then need the data in the row concerned copied and pasted into sheet 3 and in column F mark as "NOT IN TAB"
3) If there is a duplicated entry in the sheet called "WFD" I then need the data in the row concerned copied and pasted into sheet 3 and in column F mark as "DUPLICATE"


Is this possible?

Thanks

 

[DanteAmor]

Try this

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("A3:D" & sh1.Range("A" & Rows.Count).End(xlUp).Row).Value2
  b = sh2.Range("A3: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("A3").Resize(n, 6).Value = c()
  MsgBox "Done"
End Sub

 

[ghrek]

Absolutely brilliant. Many many thanks

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[ghrek]

Hi people sorry to be a pain I forgot to ask for one thing to be added if poss. Where stuff is duplicated in the tab called "WFD" Can I also get that marked up on sheet 3 and show as "DUPLICATED WFD"

 

[DanteAmor]

Hi people sorry to be a pain I forgot to ask for one thing to be added if poss. Where stuff is duplicated in the tab called "WFD" Can I also get that marked up on sheet 3 and show as "DUPLICATED WFD"

That is already done by the macro, it is your point number 3 d your initial requirement.