delete rows in source workbook if they exist in another workbook

ajm

Well-known Member
Joined
Feb 5, 2003
Messages
2,005
Office Version
  1. 365
Platform
  1. Windows
Hi all, I am working on a little procedure to import data from one file into my Source workbook. Currently works fine although possibly long winded. A new requirement was added this morning to remove rows in the source workbook where they exist in the new workbook prior to importing them. The data relates to appointments. So, if the new data contains appointments for the first week of June (3-8), and my existing data includes appointments up to the 5th June, prior to importing the new appointments for the coming week, i need to delete any appointments in the Source workbook that are made for the 3rd, 4th, & 5th June.

I think this could be done by creating a list of dates from both workbooks using advanced filter, then deleting the records from the source workbook where the dates match??? Is there an easier, or more efficient method?

(ps i have posted this question at the bottom of another thread containing code so far for this job. https://www.mrexcel.com/forum/excel-questions/1097827-why-copy-paste-so-tricky-vba.html )
 
How about
Code:
Sub ajm()
   Dim Cl As Range
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   
   Set Ws1 = Sheets("List")
   Set Ws2 = Sheets("Pcode")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         .Item(CDate(Cl.Value)) = Empty
      Next Cl
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         If .Exists(CDate(Cl.Value)) Then .Remove (CDate(Cl.Value))
      Next Cl
      Ws2.Range("A1").AutoFilter 1, .Keys, xlFilterValues
   End With
End Sub
 
Upvote 0

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
How about
Code:
Sub ajm()
   Dim Cl As Range
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   
   Set Ws1 = Sheets("List")
   Set Ws2 = Sheets("Pcode")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         .Item(CDate(Cl.Value)) = Empty
      Next Cl
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         If .Exists(CDate(Cl.Value)) Then .Remove (CDate(Cl.Value))
      Next Cl
      Ws2.Range("A1").AutoFilter 1, .Keys, xlFilterValues
   End With
End Sub

am i looking at this correctly? the first For Each loop picks up all names that appear column A on sheet Pcode and pops them into the dictionary. the second For Each loop then checks for the existence of each name in the list of names I want to keep against the dictionary (list of all names), and removes these names from the dictionary. The remaining names in the dictionary object will be all the names I don't want. These are then passed to the autofilter for me to delete.
 
Upvote 0
in this piece, my list contained names so I removed Cdate as I din't need to convert the .items.

Code:
Sub RemoveDrs()  
   Dim Cl As Range
   Dim Ws2 As Worksheet
   Dim IncludedDoctors As Variant                  'list of Drs to import
   
   IncludedDoctors = ThisWorkbook.Worksheets("NR Doctors List").Range("YesDoctors")
 
   Set Ws2 = ActiveWorkbook.Sheets("Master")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws2.Range("h2", Ws2.Range("h" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Empty
      Next Cl
      For Each Cl In ThisWorkbook.Worksheets("NR Doctors List").Range("YesDoctors") 
         If .Exists(Cl.Value) Then .Remove (Cl.Value)
      Next Cl
      Ws2.Range("A1").AutoFilter 8, .Keys, xlFilterValues
   End With
   
   With Ws2
       .Range("a2", .Range("a" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
       .AutoFilterMode = False
   End With
End Sub

its a very versatile piece of code to use. thanks Fluff.(y)
 
Last edited:
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,214,919
Messages
6,122,260
Members
449,075
Latest member
staticfluids

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