How to remove duplicates within duplication sets based on criteria?

[Paul_Hossler]

Play with this and let me know

The attachment has the code and the results

Option Explicit

Dim rData As Range

Sub DeleteSomeRows()
    Dim rData1 As Range
    Dim iRow As Long, iStart As Long, iEnd As Long
    Dim aCounts() As Long, aChecks() As Long
    
    
    'setup
    Application.ScreenUpdating = False
    Set rData = ActiveSheet.Cells(1, 1).CurrentRegion
    Set rData1 = rData.Cells(2, 1).Resize(rData.Rows.Count - 1, rData.Columns.Count)
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=rData1.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=rData1.Columns(4), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange rData
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'pass #1 - for a m/z, (all col 2 outside) OR (all col 3 outside) OR (all col 4 outside) or (any col 2 outside)
    iStart = 2
    iEnd = iStart
    With rData
        For iRow = 2 To .Rows.Count
            If .Cells(iRow + 1, 1).Value = .Cells(iRow, 1).Value Then
                iEnd = iEnd + 1
            Else
                Call CheckData1(iStart, iEnd)
                iStart = iRow + 1
                iEnd = iStart
            End If
        Next iRow
    End With
    On Error Resume Next
    rData.Columns(1).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
    On Error GoTo 0
    
    
    'pass #2 - for a m/z with 2+ rows, (ANY col 3 outside)
    iStart = 2
    iEnd = iStart
    With rData
        For iRow = 2 To .Rows.Count
            If .Cells(iRow + 1, 1).Value = .Cells(iRow, 1).Value Then
                iEnd = iEnd + 1
            Else
                Call CheckData2(iStart, iEnd)
                iStart = iRow + 1
                iEnd = iStart
            End If
        Next iRow
    End With
    On Error Resume Next
    rData.Columns(1).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
    On Error GoTo 0
    
    
    
    'pass #3 - for a m/z with 2+ rows, (ANY col 4 outside)
    iStart = 2
    iEnd = iStart
    With rData
        For iRow = 2 To .Rows.Count
            If .Cells(iRow + 1, 1).Value = .Cells(iRow, 1).Value Then
                iEnd = iEnd + 1
            Else
                Call CheckData3(iStart, iEnd)
                iStart = iRow + 1
                iEnd = iStart
            End If
        Next iRow
    End With
    On Error Resume Next
    rData.Columns(1).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
    On Error GoTo 0
    
    
    'pass #4 - for a m/z with 2+ rows, (largest col 4)
    iStart = 2
    iEnd = iStart
    With rData
        For iRow = 2 To .Rows.Count
            If .Cells(iRow + 1, 1).Value = .Cells(iRow, 1).Value Then
                iEnd = iEnd + 1
            Else
                Call CheckData4(iStart, iEnd)
                iStart = iRow + 1
                iEnd = iStart
            End If
        Next iRow
    End With
    On Error Resume Next
    rData.Columns(1).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
    On Error GoTo 0
    
    Application.ScreenUpdating = True
End Sub
    
    
    
Private Sub CheckData1(S As Long, E As Long)
    Dim i As Long
    Dim bAllFail As Boolean
    
    With rData
        'first test - all col 2 outside
        bAllFail = True
        For i = S To E
            If .Cells(i, 2).Value <= 2# Then bAllFail = False
        Next i
                
        If bAllFail Then
            For i = S To E
                .Cells(i, 1).Value = True
            Next i
            Exit Sub
        End If
        
        'second test - all col 3 outside
        bAllFail = True
        For i = S To E
            If .Cells(i, 3).Value <= 1# Then bAllFail = False
        Next i
                
        If bAllFail Then
            For i = S To E
                .Cells(i, 1).Value = True
            Next i
            Exit Sub
        End If
        
        
        'third test  - all col 4 outside
        bAllFail = True
        For i = S To E
            If .Cells(i, 4).Value <= 2.25 Then bAllFail = False
        Next i
                
        If bAllFail Then
            For i = S To E
                .Cells(i, 1).Value = True
            Next i
            Exit Sub
        End If
        
        'fourth test  - ANY col 2 outside
        For i = S To E
            If .Cells(i, 2).Value > 2# Then .Cells(i, 1).Value = True
        Next i
    
    End With
End Sub
    
    
Private Sub CheckData2(S As Long, E As Long)
    Dim i As Long
    
    If S = E Then Exit Sub
    
    With rData
        'any col 3 outside
        For i = S To E
            If .Cells(i, 3).Value > 1# Then .Cells(i, 1).Value = True
        Next i
    End With
End Sub
    
Private Sub CheckData3(S As Long, E As Long)
    Dim i As Long
    
    If S = E Then Exit Sub
    
    With rData
        'any col 4 outside
        For i = S To E
            If .Cells(i, 4).Value > 2.25 Then .Cells(i, 1).Value = True
        Next i
    End With
End Sub
    
Private Sub CheckData4(S As Long, E As Long)
    Dim i As Long
    Dim m As Double
    
    If S = E Then Exit Sub
    
    With rData
        m = 0#
        For i = S To E
            If .Cells(i, 4).Value > m Then m = .Cells(i, 4).Value
        Next i
        For i = S To E
            If .Cells(i, 4).Value < m Then .Cells(i, 1).Value = True
        Next i
    
    End With
End Sub