VBA to compare data on two tabs and delete rows on the second one where there isnt a match

[gheyman]

I am in need of code that will compare the data on my tab named "List" to data on my tab named Cost Source

The List tab has three columns Material, ID and Revision. They are in columns B, C and D with the titles listed in Row 15

On the Cost Source tab I have these three columns plus many more. The Material is in Column A, the ID is in Column D and the Revision is in Column E (there headers all start in row 2 and the data starts in row 3).

If the row on the Cost Source tab does not have a Match (for all three columns on the list tab) then I need to delete the entire row.

Material	ID	Revision
0000-11398-0000	SQ220518085140AM	52218
0000-51863-0001	SQ220518085330AM	52218

Material	Material Type	Type	ID	Revision
1N5408	Part	Quote	SQ220405042751NM	42205
0000-11398-0000	Part	Quote	SQ220518085140AM	52218
0000-51863-0001	Part	PO	SQID397267	220318
0000-51863-0001	Part	Quote	SQ220518085330AM	52218

So in the above example, the rows 1 and 4 would be deleted from the second table.


Your time and help is very much appreciated. Trying to learn from the best.

Thanks

 

[gheyman]

Sorry for not including this in the original post. Also would like to learn how I would do this if I wanted to just compare one column, like the Material column. This would be separate code from the above. Delete rows where there wasn't a match just for the Material columns. Thanks

 

[SidharthS]

how about doing this without VBA by Creating new column for both of the List
and Concatenate 3 cells in same order for both tables
then
using Vlookup in CostSourceTab then deleting all rows containing errors in vlookup column

 

[gheyman]

Thanks, but I would rather use VBA because I have a lot of users. This tool will be used over and over again and to have the users add formulas or count on them to copy it, not to delete it..... is problematic.

Even if the code had to go through each column one by one, starting with the Material column, this would be much more preferable. I don't want to use Power Query either, because of the Processing time to make tables...

I was really hoping to loop through and delete each unmatched row.

But I appreciate the suggestion.

 

[Flaiban]

Try this code...

Sub CostSource()
   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("Cost Source")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws1.Range("C14", Ws1.Range("B" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then .Add Cl.Value, Cl
      Next Cl
      For Each Cl In Ws2.Range("D2", Ws2.Range("D" & 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

 

[gheyman]

Thank You!

 

[gheyman]

I know I checked this one off, but I just realized something.

When its removing Rows its only keeping one matched row. (its searching the data on the Cost Sources tab for matching Part numbers on the List tab - but if the part number is listed more than once on the Cost Sources tab, its deleting the additional rows)

So I modified this slightly so that its comparing Part Numbers between the two tabs. In my Cost Sources tab I have the Part Number 123-TEST on two different rows (each row has a different CostSourceId and Revision).

When I run this code, its only keeping one of the Rows with 123-TEST listed as the Part number. I need it to keep all.

Is there a way to modify this so that its not deleting the other rows?

Sub PartNumber_CostSources()
'*****************************************************************************************************************
'Based on the data listed on the "List" tab, remove any unmacthed CostSourceId 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("Cost Sources")
   With CreateObject("scripting.dictionary")
   'Column D of the List tab is the Part Number
      For Each Cl In Ws1.Range("D14", Ws1.Range("B" & 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

Thank you

 

[gheyman]

Any help is appreciated.

 

[Flaiban]

Any help is appreciated.

Hey , Bro...whats up ?
Now , I hope help you...

Sub GHeyman()

 Dim d As Object, i As Long, j As Long, concval
    Set d = CreateObject("scripting.dictionary")
    With Sheets("List")
        For i = 14 To .Range("B" & Rows.Count).End(xlUp).Row
            concval = Array(.Cells(i, 2), .Cells(i, 3), .Cells(i, 4))
            d(Join(concval, "")) = 1
        Next i
    End With

    With Sheets("Cost Sources")
        For j = 1 To .Range("A" & Rows.Count).End(xlUp).Row
            concval = Array(.Cells(j, 1), .Cells(j, 4), .Cells(j, 5))
            If d(Join(concval, "")) <> 1 Then
                .Cells(j, 1).Resize(1, 5).EntireRow.Delete
            End If
        Next j
    End With
End Sub

If nothing to match , Cost Sources delete cells