VBA to delete entire rows that do not match a list

ConfusedResearcher

New Member
Joined
Jun 29, 2020
Messages
5
Office Version
  1. 365
Platform
  1. MacOS
Hi, I've recent found out what VBA was and I'm running into a problem. My workbook has 200 pages, with one page being a list of names (proteins) and the other pages being filled with 10,000+ rows containing both protein names and other data. Since the protein names are in Column B on the other worksheets, I want to write a code that that looks specifically at Column B on the sheets, and delete all rows that do not contain names from my list. I've looked at other codes, but none of them seem to be working. Thanks!
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Welcome to the board. Try recording a macro that copies your actions, and post the resulting code back - do this for 1 sheet.

Reason being without your workbook no idea what the sheet names are, the source sheet with the protein name list etc.

Otherwise, what is the name of the sheet with the list of proteins, what cell does this list start in and end in?
What are the names of the sheets to check column B in and delete rows from?
 
Upvote 0
Hey Jack,

Thanks for the response and reception! Unfortunately, I'm not sure if recording a macro would work, because not all the worksheets will contain proteins from the list and therefore the same sequence might not be the same for all the sheets.

Currently, the list of proteins is on a sheet titled "List" with the first list starting at cell A2 (there's a header) and ending at A117. For the other worksheets, the rows start at B22 (and ending at various different cells depending on the sheet). I'm not sure if this was possible with VBA, but I wanted a macro that didn't need the worksheets it was deleting rows from to be named so that I could loop it throughout all the worksheets in the workbook. But if that's not possible, then the name of one of the worksheets to check column B and delete rows from is "RAB8A".

Thanks again for the time!
 
Upvote 0
Hi, what is the end column in each sheet to check?
Does this end column vary?
Is there a header row in row 21?
rows start at B22
 
Upvote 0
Using scraps of code from other posts,

1. The end column to check varies, so
Set cRange = Range("B22:B" & LastRow)

2. There is no header in Row 21 (or anything significant above row 22).

Alternative, if it makes it any easier, I can rearrange the data so the the protein names are instead in column A, with the range being from A1. I'm assuming the end column to check then will be

Set cRange = Range("A1:A" & LastRow)

Hope this is useful!
 
Upvote 0
Reason to ask for end column, I think sorting data is faster than deleting data, especially if you have 200 worksheets or so to repeat this over.

Tested as best as possible, however recommend making a copy of your workbook, before deleting all the code and replacing with below before trying:
Code:
Option Explicit

Sub StripProteins()
   
    Process_Sheets Protein_List(Sheet_List)
    Macro_Finish
   
End Sub

Private Function LastCell(ByRef w As Worksheet, Optional ByRef d As Boolean = False) As Long

    With w.Cells
        LastCell = .Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
        If d Then LastCell = .Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByColumns, xlPrevious, False).Column
    End With
           
End Function

Private Function Sheet_List() As Worksheet

    On Error Resume Next
    Set Sheet_List = Sheets("List")
    On Error GoTo 0
   
    If Sheet_List Is Nothing Then
        MsgBox "Sheet List not found!", vbExclamation, "List Sheet Not Found"
    Else
        Application.ScreenUpdating = False
        Sheet_List.Move before:=Sheets(1)
        Application.ScreenUpdating = True
    End If
   
End Function

Private Function Protein_List(ByRef w As Worksheet) As Object

    Dim d   As Object: Set d = CreateObject("Scripting.Dictionary")
    Dim v   As Variant
    Dim x   As Long
   
    With w
        v = .Range("A2:A" & LastCell(w)).Value
    End With
   
    For x = LBound(v, 1) To UBound(v, 1)
        d(v(x, 1)) = x
    Next x
   
    Set Protein_List = d
   
End Function

Private Sub Process_Sheets(ByRef v As Object)
   
    Dim w   As Long
   
    Application.ScreenUpdating = False
   
    For w = 2 To Worksheets.Count
        Test_Sheet Sheets(w), v, LastCell(w), LastCell(w, True)
    Next w
       
    Application.ScreenUpdating = True
       
End Sub

Private Sub Test_Sheet(ByRef w As Worksheet, v As Object, ByRef LR As Long, ByRef LC As Long)

    Dim key As Variant
    Dim r   As Range
   
    On Error Resume Next
   
    With w
        LR = LastCell(w)
        LC = LastCell(w, True)
        Set r = .Range("B22:B" & LR)
        r.Select
        For Each key In v
            r.Replace key, ""
        Next key
    End With
   
    With r
        .SpecialCells(xlCellTypeBlanks).EntireRow.Value = vbNullString
        .Resize(, LC).Sort key1:=r.Cells(1, 1), order1:=xlAscending
    End With
   
    On Error GoTo 0
End Sub

Private Sub Macro_Finish()

    Sheets(1).Activate
    MsgBox "Finished clearing proteins out", vbOKOnly, "No Keto Diet Here"
   
End Sub
One assumption made is in the sheets it searches through, there isn't any data in column A (as it checks B22 and down). If there is, code will need a small adjustment, but see how you get on.
 
Upvote 0
I ran into a hiccup because I'm running it on a Mac, but I managed to get around it and the code runs perfectly! Many thanks again, you just saved me days of sorting through all the data.
 
Upvote 0
Haha ok so despite it saying platform MacOS, I assumed it was Windows!

Glad to hear it works and problem is resolved - out of curiosity (as I have little experience VBA and MacOS other than file paths are an absolute pain and MaCOS doesn't seem to have a scripting dictionary library so you have to have work arounds*) what did you change or didn't work?

*Here for reference: Dictionary Class in VBA instead of Scripting.Dictionary
 
Upvote 0
I just combed through forums for a bit, and stumbled upon this post. Some of the solutions there were outdated/too arcane for me to understand, but I found that downloading this file, unzipping it, and then importing it into excel managed to resolve everything. Cheers and hope it comes in handy if you encounter other MacOs users like me!
 
Upvote 0

Forum statistics

Threads
1,213,565
Messages
6,114,337
Members
448,568
Latest member
Honeymonster123

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