Excel Macro to delete row if one of 37 plus names is found

sample data.xlsHello Everyone!

I need help to create a macro to delete a row if a certain name is found in column F of sheet2. The problem is that there are over 37 names and the name format is Last name, First name the middle initial. A few of the names are even more challenging. Below are a few examples of the name format:

Rusk, Debra L
O'Donnell, Daniel P
Palmer-Smith, Victoria C
Weinstein, Elizabeth
Sequera Sanchez, Ivan D

it would be nice or better I should say is to upload a workbook with the data and show what rows would be deleted

You can just mock up and example with some data and the challenging data, Show how it excist on bothe sheets.

Ok see if this will do what you need?

Option Explicit
Sub abc()
Dim FoundCell As Range, RangeToDelete As Range
Dim i As Long
Dim a As Variant
Dim ws1 As Worksheet
    
    
    With Worksheets("Sheet2")
        a = .Range("f2:f" & .Cells(Rows.Count, "f").End(xlUp).Row)
    End With
    
    Set ws1 = Worksheets("sheet1")
    With ws1
        For i = 1 To UBound(a)
            Set FoundCell = .Range("f:f").Find(What:=a(i, 1), LookAt:=xlWhole)
            If Not FoundCell Is Nothing Then
                If RangeToDelete Is Nothing Then
                    Set RangeToDelete = .Cells(FoundCell.Row, "a")
                Else
                    Set RangeToDelete = Union(RangeToDelete, .Cells(FoundCell.Row, "a"))
                End If
            End If
        Next i
        If Not RangeToDelete Is Nothing Then
            RangeToDelete.EntireRow.Delete
        End If
    End With
    Set ws1 = Nothing
    Set FoundCell = Nothing
    Set RangeToDelete = Nothing
End Sub

So you just want to delete 1 physicians Name from sheet1. You lost me? So working with your sample sheets what is to happen? Are you wanting to be able to select a name on sheet 1 and look on sheet 2 if that name is there, delete it from sheet1?

So the deleting of rows is to be done on sheet2?

Out of that I want to delete 37 or more specific ones

Where is the Specific list located? Is my macro just backwards? Should I be deleting rows on sheet2 where there names are on sheet 1?

See if this will work. I would have a list of names somewhere so that I didnt have to mess with the code anytime I wanted to make changes to the names

Option Explicit
Sub abc()
Dim ws As Worksheet
Dim FoundCell As Range
Dim RangeToDelete As Range
Dim drNames As Variant
Dim i As Long
    
    
    'Dr names in column a on some sheeet
    'If you want to use this way uncomment the next 3 lines
    'With Worksheets("somesheet")
    '    drNames = .Range("a1:a" & .Cells(Rows.Count, "a").End(xlUp).Row)
    'End With
    
    ' Add more names
    'If you use the above method comment out the line below
    drNames = Array("O'Donnell, Daniel P", "Palmer-Smith, Victoria C")

    Set ws = Worksheets("sheet2")
    With ws
        For i = LBound(drNames) To UBound(drNames)
            Set FoundCell = .Range("f:f").Find(What:=drNames(i), LookAt:=xlWhole)
            If Not FoundCell Is Nothing Then
                If RangeToDelete Is Nothing Then
                    Set RangeToDelete = .Cells(FoundCell.Row, "a")
                Else
                    Set RangeToDelete = Union(RangeToDelete, .Cells(FoundCell.Row, "a"))
                End If
            End If
        Next i
        If Not RangeToDelete Is Nothing Then
            RangeToDelete.EntireRow.Delete
        End If
    End With
    
    Set ws = Nothing
    Set FoundCell = Nothing
    Set RangeToDelete = Nothing
    
End Sub

So did that code work what you were wanting? Yea there is a way. how many times will you be updating the list? If not that much why not just hide the sheet? Or from the VbaProject Window select the sheet and in the Properties set visible to xlsheetveryhidden if you dont want anyone to access the sheet.

Also will the Doctor that you want to delete, Name be listed more then Once? If so will I will need to update the code.

Opps that was my bad I should off set that up to in case you wanted to work with a worksheet. Being were working/setting the array with a range in becomes a 2 dimensional array.

So change drNames(i) to drNames(i,1) .

Set FoundCell = .Range("f:f").Find(What:=drNames(i,1), LookAt:=xlWhole)

This works for me.

sample data (1).xls

Heres the workbook to delete more then one

sample data (2).xls

Yea I didnt get you response to there would be more Dr names before I posted the workbook. This code below should do what you need.

Sub abc()
Dim ws As Worksheet
Dim FoundCell As Range
Dim RangeToDelete As Range
Dim drNames As Variant
Dim i As Long
Dim LastCell As Range
Dim FirstAddr As String

    With Worksheets("sheet3")
        drNames = .Range("a1:a" & .Cells(Rows.Count, "a").End(xlUp).Row)
    End With

    Set ws = Worksheets("sheet2")
    With ws
        With .Range("f:f")
            Set LastCell = .Cells(.Cells.Count)
        End With
        For i = LBound(drNames) To UBound(drNames)
            Set FoundCell = .Range("f:f").Find(What:=drNames(i, 1), LookAt:=xlWhole)
            If Not FoundCell Is Nothing Then
                FirstAddr = FoundCell.Address
            End If
            Do Until FoundCell Is Nothing
                If RangeToDelete Is Nothing Then
                    Set RangeToDelete = .Cells(FoundCell.Row, "a")
                Else
                    Set RangeToDelete = Union(RangeToDelete, .Cells(FoundCell.Row, "a"))
                End If
                Set FoundCell = .Range("f:f").FindNext(After:=FoundCell)
                If FoundCell.Address = FirstAddr Then
                    Exit Do
                End If
            Loop

        Next i
        If Not RangeToDelete Is Nothing Then
            RangeToDelete.EntireRow.Delete
        End If
    End With
    
    Set ws = Nothing
    Set FoundCell = Nothing
    Set RangeToDelete = Nothing
    
End Sub

Sorry took so long had some things to take care of. Let me know if you have any problems

You will need to update the Const at the top of the Sub. sFilePath to the Path of the file. sFileName to the name of the file. shPhysicians to the Name of the sheet that has the Physicians Names.

Sub abc()
Const sFilePath As String = "C:\Users\Mike\Desktop\"    ' File Path must have "\" at the end path
Const sFileName As String = "PhysiciansList.xls"        ' File Name
Const shPhysicians As String = "Names"                  ' Sheet name from PhysiciansList Workbook
Dim ws As Worksheet
Dim FoundCell As Range
Dim RangeToDelete As Range
Dim drNames As Variant
Dim i As Long, LastRow As Long
Dim LastCell As Range
Dim FirstAddr As String
Dim xlApp As New Excel.Application
Dim xlWb As Workbook

        
    On Error Resume Next
    Set xlWb = xlApp.Workbooks.Open(sFilePath & sFileName, ReadOnly:=True)
    If Err.Number <> 0 Then
        MsgBox "Error #:" & Err.Number & vbCrLf & "Description:" & Err.Description, vbCritical, "Error"
        Set xlApp = Nothing
       Exit Sub
    End If
    With xlWb.Worksheets(shPhysicians)
        drNames = .Range("a1:a" & .Cells(Rows.Count, "a").End(xlUp).Row)
    End With
    If Err.Number <> 0 Then
        MsgBox "Could not find Sheet name: " & shPhysicians, vbCritical, "Error"
        xlWb.Close
        xlApp.Quit
        Set xlApp = Nothing
        Set xlWb = Nothing
       Exit Sub
    End If
    On Error GoTo 0
    
    xlWb.Close
    xlApp.Quit
    Set xlApp = Nothing
    Set xlWb = Nothing
    
    Set ws = Worksheets("sheet2")
    With ws
        LastRow = .Cells(Rows.Count, "f").End(xlUp).Row
        With .Range("f2:f" & LastRow)
            Set LastCell = .Cells(.Cells.Count)
        End With
        For i = LBound(drNames) To UBound(drNames)
            Set FoundCell = .Range("f2:f" & LastRow).Find(What:=drNames(i, 1), LookAt:=xlWhole)
            If Not FoundCell Is Nothing Then
                FirstAddr = FoundCell.Address
            End If
            Do Until FoundCell Is Nothing
                If RangeToDelete Is Nothing Then
                    Set RangeToDelete = .Cells(FoundCell.Row, "a")
                Else
                    Set RangeToDelete = Union(RangeToDelete, .Cells(FoundCell.Row, "a"))
                End If
                Set FoundCell = .Range("f2:f" & LastRow).FindNext(After:=FoundCell)
                If FoundCell.Address = FirstAddr Then
                    Exit Do
                End If
            Loop

        Next i
        If Not RangeToDelete Is Nothing Then
            RangeToDelete.EntireRow.Delete
        End If
    End With
    
    Set ws = Nothing
    Set FoundCell = Nothing
    Set RangeToDelete = Nothing
    
End Sub

Click Thread Tools above your first post, select "Mark your thread as Solved". Also can click the star under my last post and leave a comment.
Also might want to recopy the code I made a change to it as soon I hit save and you may copied it before I updated it.