Trim Database based on cell values in another sheet

[Tysla]

I have 2 worksheets....




In Sheet1, I have a list of 100 Static IDs ( they never change ) in Column D. Starting from D11 to D111


In Sheet2, I have a dynamic database ( updated daily ) of about 25,000 rows. Each ID ( from Sheet1 ) will appear ONLY ONCE in Sheet2.ColA.


Need a VBA to delete rows, where the value in Column A is NOT EQUAL to any of the 100 IDs.


In short, I need a procedure to trim the Sheet2 from 20,000 rows down to 100 rows only.


Also, if possible to sort the Sheet2 data, in the same order Sheet1

Thanks..........

 

[Fluff]

Hi & welcome to MrExcel
How about

Sub Tysla()
   Dim Ary As Variant
   Dim Dic As Object
   Dim i As Long
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Sheet2")
      Ary = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value2
      For i = 1 To UBound(Ary)
         Dic(Ary(i, 1)) = Empty
      Next i
      Ary = Sheets("Sheet1").Range("D11:D111").Value2
      For i = 1 To UBound(Ary)
         If Dic.exists(Ary(i, 1)) Then Dic.Remove Ary(i, 1)
      Next i
      .Range("A1").AutoFilter 1, Dic.keys, xlFilterValues
      .AutoFilter.Range.Offset(1).EntireRow.Delete
      .AutoFilterMode = False
   End With
End Sub

 

[Tysla]

Hi Fluff,....Thank you for the Welcome.....Nothing is happening...The Macro just runs and database is still intact...

 

[Fluff]

Are your sheet names "Sheet1" and "Sheet2"?
Also do you have a header in sheet2 row 1, with the data starting in A2?

 

[sandy666]

With PowerQuery (Get&Transform) merge two tables by ID with InnerJoin option.
It will not delete rows but create new table with proper result

 

[Tysla]

Yes..

 

[Fluff]

Add the two message boxes as shown, what do they say

Sub Tysla()
   Dim Ary As Variant
   Dim Dic As Object
   Dim i As Long
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Sheet2")
      Ary = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value2
      For i = 1 To UBound(Ary)
         Dic(Ary(i, 1)) = Empty
      Next i
      [COLOR=#0000ff]MsgBox Dic.Count[/COLOR]
      Ary = Sheets("Sheet1").Range("D11:D111").Value2
      For i = 1 To UBound(Ary)
         If Dic.exists(Ary(i, 1)) Then Dic.Remove Ary(i, 1)
      Next i
     [COLOR=#0000ff] MsgBox Dic.Count[/COLOR]
      .Range("A1").AutoFilter 1, Dic.keys, xlFilterValues
      .AutoFilter.Range.Offset(1).EntireRow.Delete
      .AutoFilterMode = False
   End With
End Sub

 

[Tysla]

My Sheet2 has 15600 Rows....

The first message says "15599" and the second message says "15554"...

Both these rows have valid data

 

[Fluff]

Ok, those numbers mean that you should have 45 rows of data left after deleting the unwanted rows.
Does that sound about right?
If you put the cursor on this line of code

.Range("A1").AutoFilter 1, Dic.keys, xlFilterValues

& then press F9 it should be highlighted brown. Press F5 & the code should stop on that line, then press F8 and look at sheet2, has it been filtered?

 

[Tysla]

Hi Fluff...I do have 45 rows of data......out of the 100 IDS...

but the other ( 15600 - 45 ) = 15555 row of data is not deleted.....