Deleting rows that are not on a second list

[kadain]

Hi Guys and Gals
Bit Stumped on wraping my head round how to get his done but basicly am looking to make a macro that would look threw a list of unique code then delete any codes that are not on the list in a complete list
The complete list of products looks a little like this(information changed for Legal Reasons), looking for the user to put in the unque codes in to a second sheet and remove the ones not on the list in the list of products

Sample Wine June22 v1.1.xlsx
	A	B	C	D	E	F	G	H	I	J
1
2
3	Wine Product Price list effective 1st June 2022 (v1.1)
4	Product Code	Product Description		Vegan	Vegetarian	Organic	Product Size	Qty per Case
5
6	Argentina
7		Argentina Red	Region
8	324234234	Ben Marco Pinot Noir 2017	Mendoza	V	V		Bottle	6
9	22244565	Benegas Ataliva Malbec 2021	Mendoza	V	V		Bottle
10	2131311	Benegas Estate Cabernet Franc 2016	Mendoza	V	V		Bottle
11	13131231	Benegas Estate Malbec 2020	Mendoza	V	V		Bottle
12	22423234	Crios Tannat Mendoza Argentina 2018	Mendoza	V	V		Bottle	6
13	35345345	Finca la Nina Malbec 2021	Mendoza				Bottle	12
14	323113	Goyenechea 5th Generacion Malbec Gran Reserva 2014	San Rafael				Bottle	12
15	42414124	Goyenechea Cabernet Sauvignon 2020	San Rafael				Bottle	12
16	32422423	Goyenechea Centenario Malbec Reserva 2019	San Rafael				Bottle	12
17	234234322	Goyenechea Lorenza Bonarda 2017	San Rafael				Bottle	12
18	23423423	Goyenechea Malbec Mendoza 2020	San Rafael				Bottle	12
19	12411424	Goyenechea Syrah 2016	San Rafael				Bottle	12
20	34534534	Hanger And Flank Malbec	Mendoza				24 X Qtr	1
21	14414124	Hanger And Flank Malbec 2020	Mendoza				Bottle	12
22	43534345	Juan Benegas Malbec 2020	Mendoza	V	V		Bottle
23	3342424	Luna Benegas Cabernet Sauvignon 2020	Mendoza	V	V		Bottle
24	534535353	Montanes Malbec Argentina 2020	Mendoza				Bottle	12
25	345353434	Susana Balbo Crios Cabernet Sauvignon	Mendoza	V	V		Bottle	6
26	345345345	Susana Balbo Late Harvest Malbec 2019	Mendoza	V	V		50 Cl	12
27	242423454	Terrazas de Los Andes Select Malbec	Mendoza				Bottle	6
28
29		Argentina Rosé	Region
30	1231313131	Crios Rosé Of Malbec 2019	Mendoza	V	V		Bottle	6
31	3131325	Carmela Benegas Rosé 2021	Mendoza	V	V		Bottle
32	3233131231	Goyenechea Merlot Rosé Mendoza 2020	San Rafael				Bottle	12
33
34		Argentina White	Region
Wine June22 v1.1

Cell Formulas
Range	Formula
H9:H11,H31,H22:H23	H9	=IFERROR(VLOOKUP(A9,'https://inveraritymorton1.sharepoint.com/sites/SalesOps/Shared Documents/Sales Ops Private/Pricing and PINC/PINC/PINC June ''22/Team folder/[Wines June22 v1.1 (Andrew-Aidan) Working Doc.xlsx]Status'!A:G,5,FALSE),"")

i need it not to delete the spaces between the catagory headers and the catagory headers too aswell
bit of a head scratcher for me but am sure the comminty could help out here
i look forward to see what yous come up with
P.S. there is another two colounms i had to remove for legal Reasons thats why there two blanks at the end

 

[Max1616]

I think something like this might work for you. I commented the lines that you will need to adjust to the specifics of your workbook:

Sub ProductRemoval()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long
Dim j As Long
Dim lrow1 As Long
Dim lrow2 As Long
Dim ProductIDClm As Integer
Dim Check As Boolean

Set ws1 = Sheets("Complete List") 'Change this to the name of the sheet with the full list
Set ws2 = Sheets("Keep List") 'change this to the name of the sheet with the products you'd like to keep

ProductIDClm = 1 'This represents that column you're product IDs are in. I have currently set to 1, which = column A. (2 = column B, 3 = column C, etc...). This macro assumes your IDs will be in the same column in both sheets (Column A)

lrow1 = ws1.Cells(Rows.Count, ProductIDClm).End(xlUp).Row
lrow2 = ws1.Cells(Rows.Count, ProductIDClm).End(xlUp).Row

For i = lrow1 To 1 Step -1
    If Application.IsNumber(ws1.Cells(i, ProductIDClm)) = True Then
        Check = False
        
        For j = 1 To lrow2
            If ws1.Cells(i, ProductIDClm) = ws2.Cells(j, ProductIDClm) Then Check = True
        Next j
        
        If Check = False Then Cells(i, ProductIDClm).EntireRow.Delete
    End If

Next i

End Sub

 

[kadain]

I think something like this might work for you. I commented the lines that you will need to adjust to the specifics of your workbook:

Sub ProductRemoval()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long
Dim j As Long
Dim lrow1 As Long
Dim lrow2 As Long
Dim ProductIDClm As Integer
Dim Check As Boolean

Set ws1 = Sheets("Complete List") 'Change this to the name of the sheet with the full list
Set ws2 = Sheets("Keep List") 'change this to the name of the sheet with the products you'd like to keep

ProductIDClm = 1 'This represents that column you're product IDs are in. I have currently set to 1, which = column A. (2 = column B, 3 = column C, etc...). This macro assumes your IDs will be in the same column in both sheets (Column A)

lrow1 = ws1.Cells(Rows.Count, ProductIDClm).End(xlUp).Row
lrow2 = ws1.Cells(Rows.Count, ProductIDClm).End(xlUp).Row

For i = lrow1 To 1 Step -1
    If Application.IsNumber(ws1.Cells(i, ProductIDClm)) = True Then
        Check = False
       
        For j = 1 To lrow2
            If ws1.Cells(i, ProductIDClm) = ws2.Cells(j, ProductIDClm) Then Check = True
        Next j
       
        If Check = False Then Cells(i, ProductIDClm).EntireRow.Delete
    End If

Next i

End Sub

thank you for the your help, i tried this macro in my workbook, renamed the two sheets and it didnt seem to work, all the other products still remain

 

[kadain]

I think something like this might work for you. I commented the lines that you will need to adjust to the specifics of your workbook:

Sub ProductRemoval()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long
Dim j As Long
Dim lrow1 As Long
Dim lrow2 As Long
Dim ProductIDClm As Integer
Dim Check As Boolean

Set ws1 = Sheets("Complete List") 'Change this to the name of the sheet with the full list
Set ws2 = Sheets("Keep List") 'change this to the name of the sheet with the products you'd like to keep

ProductIDClm = 1 'This represents that column you're product IDs are in. I have currently set to 1, which = column A. (2 = column B, 3 = column C, etc...). This macro assumes your IDs will be in the same column in both sheets (Column A)

lrow1 = ws1.Cells(Rows.Count, ProductIDClm).End(xlUp).Row
lrow2 = ws1.Cells(Rows.Count, ProductIDClm).End(xlUp).Row

For i = lrow1 To 1 Step -1
    If Application.IsNumber(ws1.Cells(i, ProductIDClm)) = True Then
        Check = False
       
        For j = 1 To lrow2
            If ws1.Cells(i, ProductIDClm) = ws2.Cells(j, ProductIDClm) Then Check = True
        Next j
       
        If Check = False Then Cells(i, ProductIDClm).EntireRow.Delete
    End If

Next i

End Sub

also sorry for the long waited reply, my patner took not well over the long weekend

 

[kadain]

Maybe even change it up and keep the rows that have a "yes" or "y" in an extra coloumn at the end and delete the rest

 

[Max1616]

Do you know if your product IDs are formatted as Numbers?

To check this, you can use the formula =Type(A1) on your product IDs to see if it = 1 (1 = Number).

the macro I wrote requires the values to be a number and will ignore everything that's not a number.

 

[kadain]

Do you know if your product IDs are formatted as Numbers?

To check this, you can use the formula =Type(A1) on your product IDs to see if it = 1 (1 = Number).

the macro I wrote requires the values to be a number and will ignore everything that's not a number.

The product id’s are a few numbers followed by a letter unfortunately I can’t change these

 

[kadain]

So ive been working away at some of my own coding and and managed to get it to the point where its deleted everything except the products i want to keep and all the region headers, alot of them dont have any information in them due to them being removed prducts, so now working on a way to delete off the unwated one, was thinking mayone something that identifys that colounm A + B have values keep the first bold it find above it

here an example of what am left with after i run my code and how the product id looks

Wine v1.1 macro.xlsm
	A	B	C	D	E	F	G	H
15	Australia
16		Australia Red	Region
17	32145Y	Normans Holbrooks Rd Shiraz 2019	South Australia				Bottle	12
18
19		Australia Sparkling	Region
20
21		Australia White	Region
22
23		Austria Red	Region
24
25		Austria White	Region
26
27	Chile
28		Chile Red	Region
29
30		Chile Rosé	Region
31
32		Chile White	Region
33	54321R	Senora Rosa Sauvignon Blanc 2021	Central Valley				Bottle	12
34
35	England
36		England Sparkling	Region
37
38	France
39		France Sparkling Wine	Region
40
41		France Branded Champagne	Region
42	12345T	Ayala Brut Majeur N.V.	Ay				Bottle	6
43
Complete List Helper

i dont know if this would be any easier than redoing the orignal code you gave me but thought it might help
hoping to hear from you soon

 

[Max1616]

Try this for removing the empty records:

Sub Remove()

For i = Cells(Rows.Count, 2).End(xlUp).Row To 1 Step -1

    If Cells(i, 1) = "" And Cells(i, 2) = "" Then
        Cells(i, 2).EntireRow.Delete
        GoTo Nexti
    End If

    If Cells(i, 1) = "" And Cells(i, 2) <> "" And Cells(i, 2).Font.Bold = True And (Cells(i + 1, 1).Font.Bold = True Or Cells(i + 1, 1) = "") Then
        Cells(i, 2).EntireRow.Delete
        GoTo Nexti
    End If
    
    If Cells(i, 1) <> "" And Cells(i, 1).Font.Bold = True And Cells(i + 2, 1) = "" Then
        Cells(i, 2).EntireRow.Delete
        GoTo Nexti
    End If
    
Nexti:
Next i

End Sub

 

[kadain]

Try this for removing the empty records:

Sub Remove()

For i = Cells(Rows.Count, 2).End(xlUp).Row To 1 Step -1

    If Cells(i, 1) = "" And Cells(i, 2) = "" Then
        Cells(i, 2).EntireRow.Delete
        GoTo Nexti
    End If

    If Cells(i, 1) = "" And Cells(i, 2) <> "" And Cells(i, 2).Font.Bold = True And (Cells(i + 1, 1).Font.Bold = True Or Cells(i + 1, 1) = "") Then
        Cells(i, 2).EntireRow.Delete
        GoTo Nexti
    End If
   
    If Cells(i, 1) <> "" And Cells(i, 1).Font.Bold = True And Cells(i + 2, 1) = "" Then
        Cells(i, 2).EntireRow.Delete
        GoTo Nexti
    End If
   
Nexti:
Next i

End Sub

Absoultly Spot on, thank you so much, if you have the brake down of what each line does so i can learn it a bit better that would be amazing
10/10 recommend again