Public Function DeleteDupIO()
Dim ws As Worksheet
Dim lngMaxRow As Long
Dim IOColl As Collection 'using an index you can't have duplicates
Dim IOCol As Variant
Dim strIO As String 'concatenate columns A & B & C
Dim arrDupFoundRow() As Long 'Row no of any duplicate record
Dim lngDupFound As Long 'number of duplicates found
Dim arrIOcol() As String
Dim strSearch As String
Dim blnLoop As Boolean
Set IOColl = New Collection
Set ws = ThisWorkbook.Worksheets("Sheet1") 'change Sheet1 to the name of your Sheet
'in excel earlier then 2007 change "A1048576" to "A65536"
lngMaxRow = ws.Range("A1048576").End(xlUp).Row 'find last row of data
lngDupFound = 0
For i = 2 To lngMaxRow 'loop through each row
If ws.Range("B" & i) = "IO" Then 'only want IO in column B
strIO = ws.Range("A" & i) & "_" & ws.Range("B" & i) & "_" & ws.Range("C" & i) 'concatenate columns A & B & C
On Error GoTo dupFound 'add to not found list arrDupFoundRow()
IOColl.Add strIO, strIO 'add to Collection
End If
Next i
If lngDupFound > 0 Then 'we have found more than 1 duplicate entry
For i = UBound(arrDupFoundRow) To 1 Step -1 'when deleting rows you must to in reverse otherwise you delete the wrong row
ws.Range("A" & arrDupFoundRow(i)).EntireRow.Delete 'deleted whole row
Next i
End If
'now Check both both postive and negative IO items that equate to zero to be deleted
blnLoop = True
LoopStartsHere:
Do Until blnLoop = False
blnLoop = False
'now delete both both postive and negative IO items that equate to zero
For Each IOCol In IOColl
arrIOcol = Split(IOCol, "_")
If CLng(arrIOcol(2)) < 0 Then 'we have found a negative
'do we have a postive value of the same value using the index if so ve have to delete
On Error GoTo no_Item
IOColl.Item arrIOcol(0) & "_" & arrIOcol(1) & "_" & Abs(arrIOcol(2))
'delete positive in worksheet
lngMaxRow = ws.Range("A1048576").End(xlUp).Row 'find last row of data
For i = 2 To lngMaxRow 'loop through each row in worksheet
If ws.Range("B" & i) = arrIOcol(1) Then
If ws.Range("A" & i) = arrIOcol(0) Then
If ws.Range("C" & i) = Abs(arrIOcol(2)) Then
ws.Range("C" & i).EntireRow.Delete
IOColl.Remove arrIOcol(0) & "_" & arrIOcol(1) & "_" & Abs(arrIOcol(2)) 'delete positive
Exit For
End If
End If
End If
Next i
'delete negative in worksheet
lngMaxRow = ws.Range("A1048576").End(xlUp).Row 'find last row of data
For i = 2 To lngMaxRow 'loop through each row in worksheet
If ws.Range("B" & i) = arrIOcol(1) Then
If ws.Range("A" & i) = arrIOcol(0) Then
If ws.Range("C" & i) = arrIOcol(2) Then
ws.Range("C" & i).EntireRow.Delete
blnLoop = True 'need to go round & round until no more
IOColl.Remove arrIOcol(0) & "_" & arrIOcol(1) & "_" & arrIOcol(2) 'delete negative
Exit For
End If
End If
End If
Next i
End If
no_Item:
If blnLoop = True Then Exit For
Next IOCol
If blnLoop = True Then GoTo LoopStartsHere 'go and see if any more
Loop
'clear varables to nothing
Set ws = Nothing
Set IOColl = Nothing
Erase arrDupFoundRow
Erase arrIOcol
Exit Function
dupFound:
lngDupFound = lngDupFound + 1 'add 1 to no of dups fround
ReDim Preserve arrDupFoundRow(lngDupFound) 're dimention and preserve list data to add a new one
arrDupFoundRow(lngDupFound) = i 'add row no to be deleted to the arrDupFoundRow() list
Resume Next 'go back to line after error
End Function