Option Explicit
Const cMZ As Long = 2
Const cP As Long = 10
Const cStdDev2 As Long = 12
Const cNO As Long = 14
Const cNSO As Long = 15
Const cHC As Long = 16
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)
Application.StatusBar = "Sorting"
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=rData1.Columns(cMZ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=rData1.Columns(cHC), 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
Application.StatusBar = "Pass #1 - Row " & iRow
If .Cells(iRow + 1, cMZ).Value = .Cells(iRow, cMZ).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(cMZ).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
Application.StatusBar = "Pass #2 - Row " & iRow
If .Cells(iRow + 1, cMZ).Value = .Cells(iRow, cMZ).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(cMZ).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
Application.StatusBar = "Pass #3 - Row " & iRow
If .Cells(iRow + 1, cMZ).Value = .Cells(iRow, cMZ).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(cMZ).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
Application.StatusBar = "Pass #4 - Row " & iRow
If .Cells(iRow + 1, cMZ).Value = .Cells(iRow, cMZ).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(cMZ).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
On Error GoTo 0
'tiebreaker #1 -
iStart = 2
iEnd = iStart
With rData
For iRow = 2 To .Rows.Count
Application.StatusBar = "Tiebreaker - Row " & iRow
If .Cells(iRow + 1, cMZ).Value = .Cells(iRow, cMZ).Value Then
iEnd = iEnd + 1
Else
Call TieBreaker1(iStart, iEnd)
iStart = iRow + 1
iEnd = iStart
End If
Next iRow
End With
On Error Resume Next
rData.Columns(cMZ).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
On Error GoTo 0
Application.StatusBar = False
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, cNO).Value <= 2# Then bAllFail = False
Next i
If bAllFail Then
For i = S To E
.Cells(i, cMZ).Value = True
Next i
Exit Sub
End If
'second test - all col 3 outside
bAllFail = True
For i = S To E
If .Cells(i, cNSO).Value <= 1# Then bAllFail = False
Next i
If bAllFail Then
For i = S To E
.Cells(i, cMZ).Value = True
Next i
Exit Sub
End If
'third test - all col 4 outside
bAllFail = True
For i = S To E
If .Cells(i, cHC).Value <= 2.25 Then bAllFail = False
Next i
If bAllFail Then
For i = S To E
.Cells(i, cMZ).Value = True
Next i
Exit Sub
End If
'fourth test - ANY col 2 outside
For i = S To E
If .Cells(i, cNO).Value > 2# Then .Cells(i, cMZ).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, cNSO).Value > 1# Then .Cells(i, cMZ).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, cHC).Value > 2.25 Then .Cells(i, cMZ).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, cHC).Value > m Then m = .Cells(i, cHC).Value
Next i
For i = S To E
If .Cells(i, cHC).Value < m Then .Cells(i, cMZ).Value = True
Next i
End With
End Sub
Private Sub TieBreaker1(S As Long, E As Long)
Dim bAllZeros As Boolean, bOneFailed As Boolean
Dim i As Long
Dim m As Double
If S = E Then Exit Sub
bAllZeros = True
With rData
For i = S To E
If .Cells(i, cP).Value <> 0# Then bAllZeros = False
Next i
If bAllZeros Then
m = 10 ^ 6
For i = S To E
If Abs(.Cells(i, cStdDev2).Value) < m Then m = Abs(.Cells(i, cStdDev2).Value)
Next i
If m <> 10 ^ 6 Then
For i = S To E
If Abs(.Cells(i, cStdDev2).Value) <> m Then .Cells(i, cMZ).Value = True
Next i
Else
For i = S To E
.Cells(i, cMZ).Value = True
Next i
End If
Else
bOneFailed = False
For i = S To E
If .Cells(i, cP).Value <> 0# Then
If (.Cells(i, cHC).Value < 1.5) Or (.Cells(i, cHC).Value > 2.25) Then
.Cells(i, cMZ).Value = True
bOneFailed = True
End If
End If
Next i
If Not bOneFailed Then
For i = S To E
.Cells(i, cMZ).Value = True
Next i
End If
End If
End With
End Sub