Remove lines based on multiple criteria

Try

Sub test()
Dim mr As Long, x As Long
Application.ScreenUpdating = False
With Columns("A:A")
    mr = .Cells.Find("*", searchdirection:=xlPrevious).Row
End With
Range("A:A").Insert
For x = 2 To mr
    Range("A" & x) = Range("B" & x) & Range("C" & x) & Range("E" & x)
Next
Range("G2").FormulaR1C1 = "=COUNTIF(C[-6],RC[-6])"
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=6, Criteria1:= _
        ">1", Operator:=xlAnd
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:= _
        "Inpatient Admit", Criteria2:="ED Discharge", Operator:=xlOr
Range("A1").CurrentRegion.Offset(1).EntireRow.Delete
ActiveSheet.ListObjects("Table1").AutoFilter.ShowAllData
Range("G:G").Delete
Range("A:A").Delete
End Sub

Kind regards
Leo

Hi LeoTaxi,

Thanks for putting this together. However, it looks like it's only deleting one of the entries instead of both.

If i test on the file you posted, it deletes both

kind regards
Leo

It's still only removing one for me...maybe I'm doing this wrong?

I've been going into Developer tab > Visual Basic > Inset > Module > Copy/paste code > Select all of the code and run

I'm still seeing John Smith Inpatient Admit 1/1/2018

Here file where it is working

Cheers
Leo

"Subscript out of range"

Capture.JPG