Try this:-
Sub MG24Aug38
Dim Rng As Range, Dn As Range, n As Long, txt As String
Dim K As Variant, Fd As Boolean, Q As Variant, nRng As Range
Application.ScreenUpdating = False
Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
Fd = False
txt = Join(Application.Index(Dn.Resize(, 15).Value, 0, Array(1, 6, 8, 15)), ",")
If Dn.Offset(, 4) = "US Control Injection" Then Fd = True
If Not .Exists(txt) Then
n = n + 1
.Add txt, Array(Dn, Fd)
Else
Q = .Item(txt)
If Fd Then Q(1) = True
Set Q(0) = Union(Q(0), Dn)
.Item(txt) = Q
End If
Next
For Each K In .keys
If .Item(K)(1) = True Then
If nRng Is Nothing Then
Set nRng = .Item(K)(0)
Else
Set nRng = Union(nRng, .Item(K)(0))
End If
End If
Next K
If Not nRng Is Nothing Then
nRng.EntireRow.Delete
End If
End With
Application.ScreenUpdating = False
End Sub
Regards Mick
Bookmarks