Excel VBA. Compare two lists and delete where no match
Budget: $10 – $30 USD
I have two list on two separate tabs. I am trying to run through the second tab and delete any row that does not have the same part number that is listed on the first tab.
As you can see I have code that kind of does this. The problem with this code is that it is deleting the part if it’s duplicated (on more than one row / listed more then once).
I don’t want it to do that. If for example I have part number 123-TEST listed on my first tab, I want the code to run through the second tab and delete any row that does not have Part Number 123-TEST. If Part Number 123-TEST is listed twice in two separate rows, I want to keep both Rows. For some reason I cannot figure out; the code below only keeps one row.
The project is to revise this code so that it keeps duplicates.
You should be able to figure out everything from this description and the code below - without having to ask me any questions. If you cannot, this job is not for you and please do not bid on it or accept it. I will not be able to answer any questions.
I need this today. If you know Excel VBA, this should be very easy. If you bid this and accept it and take more than two hours to complete and a working solution, I will dispute and not pay.
Sub PartNumber_Parts()
'*****************************************************************************************************************
'Based on the data listed on the "List" tab, remove any unmacthed Part Numbers data from the Cost Sources Template
'*****************************************************************************************************************
'Part Number
'
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Cl As Range
Dim Rng As Range
Dim Itm As Variant
Set Ws1 = Sheets("List")
Set Ws2 = Sheets("Parts")
With CreateObject("scripting.dictionary")
'Column D of the List tab is the Part Number
For Each Cl In Ws1.Range("D14", Ws1.Range("D" & Rows.Count).End(xlUp))
If Not .exists(Cl.Value) Then .Add Cl.Value, Cl
Next Cl
'Column D of Cost Sources is "ID"
For Each Cl In Ws2.Range("A3", Ws2.Range("A" & 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
End With
End Sub
As you can see I have code that kind of does this. The problem with this code is that it is deleting the part if it’s duplicated (on more than one row / listed more then once).
I don’t want it to do that. If for example I have part number 123-TEST listed on my first tab, I want the code to run through the second tab and delete any row that does not have Part Number 123-TEST. If Part Number 123-TEST is listed twice in two separate rows, I want to keep both Rows. For some reason I cannot figure out; the code below only keeps one row.
The project is to revise this code so that it keeps duplicates.
You should be able to figure out everything from this description and the code below - without having to ask me any questions. If you cannot, this job is not for you and please do not bid on it or accept it. I will not be able to answer any questions.
I need this today. If you know Excel VBA, this should be very easy. If you bid this and accept it and take more than two hours to complete and a working solution, I will dispute and not pay.
Sub PartNumber_Parts()
'*****************************************************************************************************************
'Based on the data listed on the "List" tab, remove any unmacthed Part Numbers data from the Cost Sources Template
'*****************************************************************************************************************
'Part Number
'
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Cl As Range
Dim Rng As Range
Dim Itm As Variant
Set Ws1 = Sheets("List")
Set Ws2 = Sheets("Parts")
With CreateObject("scripting.dictionary")
'Column D of the List tab is the Part Number
For Each Cl In Ws1.Range("D14", Ws1.Range("D" & Rows.Count).End(xlUp))
If Not .exists(Cl.Value) Then .Add Cl.Value, Cl
Next Cl
'Column D of Cost Sources is "ID"
For Each Cl In Ws2.Range("A3", Ws2.Range("A" & 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
End With
End Sub