Highlight duplicate rows excluding column and vice versa another column

maybe so

Sub Karedog2()
Dim rng As Range, rngDelete As Range
Dim arr, c As Long, i As Long, strKey As String, v1, v2

Set rng = Range("E2").CurrentRegion
rng.Offset(1).Interior.ColorIndex = xlNone
arr = rng.Value

With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(arr, 1)
        strKey = Abs(arr(i, 2)) & Chr$(2) & Abs(arr(i, 3)) & Chr$(2) & _
                 Abs(arr(i, 4)) & Chr$(2) & Abs(arr(i, 5))
        If .exists(strKey) Then
            .Item(strKey) = .Item(strKey) & "~" & i
        Else
            .Item(strKey) = i
        End If
    Next i

    For Each v1 In .keys
        If InStr(.Item(v1), "~") Then
            c = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
            For Each v2 In Split(.Item(v1), "~")
                rng.Rows(v2).Interior.Color = c
'                If rngDelete Is Nothing Then Set rngDelete = rng.Rows(v2) Else Set rngDelete = Union(rngDelete, rng.Rows(v2))
            Next v2
        End If
    Next v1
End With
End Sub

not sure, but maybe so

Sub Karedog3()
Dim rng As Range, rngDelete As Range, k&
Dim x, c As Long, i As Long, strKey As String, v1, v2

Set rng = Range("E2").CurrentRegion
rng.Offset(1).Interior.ColorIndex = xlNone
x = rng.Value

With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(x)
        strKey = Abs(x(i, 2)) & Chr$(2) & Abs(x(i, 3)) & Chr$(2) & _
                 Abs(x(i, 4)) & Chr$(2) & Abs(x(i, 5))
        If .exists(strKey) Then
            .Item(strKey) = .Item(strKey) & "~" & i
        Else
            .Item(strKey) = i
        End If
    Next i

    For Each v1 In .keys
        If InStr(.Item(v1), "~") Then
            c = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)): k = 0
            For Each v2 In Split(.Item(v1), "~")
                rng.Rows(v2).Interior.Color = c
                k = k + 1
                If k > 2 Then
                    If rngDelete Is Nothing Then Set rngDelete = rng.Rows(v2) Else Set rngDelete = Union(rngDelete, rng.Rows(v2))
                End If
            Next v2
        End If
    Next v1
End With
If Not rngDelete Is Nothing Then If MsgBox("Do You Want To Remove Duplicates ?", vbYesNo) = vbYes _
   Then rngDelete.Delete xlShiftUp
End Sub