Marco needed for comparing 2 sheets then add row if new identifier found or delete row if not found.

[strongman86]

Lads,

Need VBA code that compares 2 sheets (''Sheet1 & ''Sheet2'') in same workbook and looks for Identifier in Column B and deletes entire row on ''Sheet1'' if identifier not found in ''Sheet2'' also in Column B. If new identifier is found in ''Sheet2'' then it needs to insert row in ''Sheet1'' and copy data from all columns for this row across to ''Sheet1''. Hope that makes sense. Both sheets have headers in Row 1. Thanks.

 

[Fluff]

How about

Sub CopyData()
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   Dim Cl As Range
   Dim Rng As Range
   Dim Itm As Variant
   
   Set Ws1 = Sheets("Sheet1")
   Set Ws2 = Sheets("Sheet2")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws2.Range("B2", Ws2.Range("B" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then .Add Cl.Value, Cl
      Next Cl
      For Each Cl In Ws1.Range("B2", Ws1.Range("B" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            If Rng Is Nothing Then
               Set Rng = Cl
            Else
               Set Rng = Union(Rng, Cl)
            End If
         Else
            .Remove Cl.Value
         End If
      Next Cl
      If Not Rng Is Nothing Then Rng.EntireRow.Delete
      For Each Itm In .Items
         Itm.EntireRow.Copy Range("A" & Rows.Count).End(xlUp).Offset(1)
      Next Itm
   End With
End Sub

 

[strongman86]

Fluff,

Thanks for your reply. Code works ok when it comes to deleting row, but when new row is added on ''Sheet2'' then it doesn't create new row on ''Sheet1'' nor copy data across. Thanks.

 

[Fluff]

Missed something

      For Each Itm In .Items
         Itm.EntireRow.Copy [COLOR=#ff0000]Ws1.[/COLOR]Range("A" & Rows.Count).End(xlUp).Offset(1)
      Next Itm

 

[strongman86]

Fluff,
I have altered to the code, but still no row is added after macro is run. Iv'e failed to mention that both excel ''Sheet1'' & ''Sheet2'' contains data that is pulled from MS Database, but as I mentioned earlier it does work when row is removed. Thanks.

 

[Fluff]

Ok, how about

         Itm.EntireRow.Copy Ws1.Range("B" & Rows.Count).End(xlUp).Offset(1, -1)

 

[strongman86]

Thank you again for quick responses. I'm afraid still not working.

 

[Fluff]

What sort of values do you have in Col B?

 

[strongman86]

Fluff,

Alphanumeric.Can be as short as 2 characters or as as long as 25 characters. May also include ''spaces'' between characters or ''_'' and ''-'' . Thanks.

 

[Fluff]

Are the col B values unique?