Delete Rows if cell value in multiple columns matches on a different sheet

[csebring1983]

I am looking to delete rows from Sheet 3 in Multiple columns ( I think I might have to make tables for this ) if cell data in Columns B,F,I matches cell data from sheet 4 in column B. The VBA I have for a different sheet works but only to match 1 column as it only looks to column B on both sheets.

Sub delete_selected_rows()
Dim rng1 As Range, rng2 As Range, rngToDel As Range, c As Range
Dim lastRow As Long

With Worksheets("Sheet3")
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set rng1 = .Range("B4:B" & lastRow)
End With

Set rng2 = Worksheets("Sheet4").Range("B:B")

For Each c In rng1
If Not IsError(Application.Match(c.Value, rng2, 0)) Then
'if value from rng1 is found in rng2 then remember this cell for deleting
If rngToDel Is Nothing Then
Set rngToDel = c
Else
Set rngToDel = Union(rngToDel, c)
End If
End If
Next c

If Not rngToDel Is Nothing Then rngToDel.EntireRow.Delete
End Sub

 

[kevin9999]

Could you provide a copy of your Sheet3 using the XL2BB - Excel Range to BBCode, or better still, share your file via Dropbox, Google Drive or similar file sharing platform? It's difficult to write/test code when we don't know exactly how your dataset is structured. The following suggestion is based on your sheet3 looking like:

csebring1983.xlsm
	A	B	C	D	E	F	G	H	I	J
1
2
3		HDR1	HDR2	HDR3	HDR4	HDR5	HDR6	HDR7	HDR8
4		49	x	x	x	41	x	x	16
5		27	x	x	x	0	x	x	43
6		8	x	x	x	0	x	x	22
7		47	x	x	x	0	x	x	0
8		39	x	x	x	0	x	x	0
9		4	x	x	x	0	x	x	0
10		10	x	x	x	20	x	x	0
11		27	x	x	x	13	x	x	0
12		40	x	x	x	5	x	x	0
13		44	x	x	x	40	x	x	42
14
Sheet3

When the following code is run:

Option Explicit
Sub csebring1983()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet3")
    Set ws2 = Worksheets("Sheet4")
    Dim LCol As Long, LRow As Long
    LCol = ws1.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
    LRow = ws1.Range("B:I").Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
   
    Dim a, b, c, i As Long
    a = ws1.Range("B4:I" & LRow)
    b = ws2.Range("B2", ws2.Cells(Rows.Count, "B").End(xlUp))
    ReDim c(1 To UBound(a, 1), 1 To 1)
   
    For i = LBound(a, 1) To UBound(a, 1)
        If Application.Count(Application.Match(a(i, 1), b, 0)) > 0 Or _
            Application.Count(Application.Match(a(i, 5), b, 0)) > 0 Or _
            Application.Count(Application.Match(a(i, 8), b, 0)) > 0 Then
            c(i, 1) = 1
        End If
    Next i
   
    ws1.Cells(4, LCol).Resize(UBound(c)).Value = c
    i = WorksheetFunction.Sum(ws1.Columns(LCol))
    If i > 0 Then
        ws1.Range(ws1.Cells(3, 2), ws1.Cells(LRow, LCol)).Sort Key1:=ws1.Cells(3, LCol), _
        order1:=xlAscending, Header:=xlYes
        ws1.Cells(4, LCol).Resize(i).EntireRow.Delete
    End If
End Sub

You end up with this:

csebring1983.xlsm
	A	B	C	D	E	F	G	H	I	J
1
2
3		HDR1	HDR2	HDR3	HDR4	HDR5	HDR6	HDR7	HDR8
4		27	x	x	x	0	x	x	43
5		8	x	x	x	0	x	x	22
6		47	x	x	x	0	x	x	0
7		4	x	x	x	0	x	x	0
8		10	x	x	x	20	x	x	0
9		27	x	x	x	13	x	x	0
10		44	x	x	x	40	x	x	42
11
Sheet3

Based on your sheet4 looking like this:

csebring1983.xlsm
	B
1	Hdr
2	1
3	3
4	5
5	6
6	11
7	14
8	17
9	23
10	25
11	26
12	36
13	39
14	49
15	51
16	57
17	58
18	63
19	68
20	69
21	74
22	77
23	81
24	88
25	89
26	90
27	92
28	96
29	99
Sheet4

As you can imagine, there will (probably) need to be significant tweaking once the actual sheet layouts is known.