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

strongman86

Board Regular
Joined
Feb 15, 2017
Messages
115
Office Version
  1. 2019
Platform
  1. Windows
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.
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Add this msgbox as shown
Code:
      Next Cl
      [COLOR=#ff0000]MsgBox .Count[/COLOR]
      If Not Rng Is Nothing Then Rng.EntireRow.Delete
What does it say?
 
Upvote 0
Macro shows message ''0''.

Just to confirm I have replaced as per below:


Code:
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
      MsgBox .Count
      If Not Rng Is Nothing Then Rng.EntireRow.Delete
      For Each Itm In .Items
         Itm.EntireRow.Copy Ws1.Range("B" & Rows.Count).End(xlUp).Offset(1, -1)
      Next Itm
   End With
End Sub
 
Last edited:
Upvote 0
In that case the code cannot find any values in Sheet2 col B, that don't already exist in sheet1 col B.
 
Upvote 0
Fluff,
I'm not sure what have I done wrong, but it didn't work. I have saved and reopened spreadsheet and it started working like a magic.:) Now I came across another issue hope you can help me to sort it out. This new row is added at the bottom of the ''Sheet1'' is it possible to insert this row exactly where it was in ''Sheet2'' so the row numbers are matching up?
 
Last edited:
Upvote 0
How about
Code:
Sub CopyData2()
   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
         Ws1.Range("A" & Itm.Row).EntireRow.Insert
         Itm.EntireRow.Copy Ws1.Range("A" & Itm.Row)
      Next Itm
   End With
End Sub
 
Upvote 0
Fluff,
You are a superstar (y). Works perfect.
One last thing though. I'm looking to make refreshing data from MS query & Macro to run automatically when spreadsheet is opened. As per steps below:

1) Refresh data only on ''Sheet2''.
2) Run macro.
3) Refresh data on ''Sheet1''.
 
Upvote 0
I know nothing refreshing queries, so I suggest you start a new thread.
 
Upvote 0

Forum statistics

Threads
1,215,343
Messages
6,124,405
Members
449,157
Latest member
mytux

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top