Macro that deletes values with condition

  • Thread starter Thread starter canvas
  • Start date Start date
C

canvas

Hi,

I need a macro that deletes duplicates of numbers that appear an odd
number of times and that deletes duplicates and the value duplicated
an even number of times. Example:

Original data

A

1
2
3
1
2
1
2
3
4

Result:

A

1
2
4

Values 1 and 2 must remain and only delete duplicates because they
appear an odd number of times (3), 3 must be deleted because it
appears an even number of times (2) and 4 appears because it has no
duplicates.

Hope this can be done!

Thank you so much
 
Hi

Insert a heading in row 1 and try this macro:

Sub aaa()
Dim f As Range
Dim ResultArr()
Dim LastRow As Long

LastRow = Range("A" & Rows.Count).End(xlUp).Row
Set f = Range("A1:A" & LastRow)
'*** Heading required in row 1!
f.AdvancedFilter xlFilterInPlace, unique:=True
ReDim ResultArr(0)
ResultArr(UBound(ResultArr())) = f(1)
For Each r In f.SpecialCells(xlCellTypeVisible)
If r.Row > 1 Then
Count = WorksheetFunction.CountIf(f, "=" & r.Value)
If Count = 1 Or Count Mod 2 <> 0 Then
ReDim Preserve ResultArr(UBound(ResultArr) + 1)
ResultArr(UBound(ResultArr)) = r.Value
End If
End If
Next
ActiveSheet.ShowAllData
Columns("A").ClearContents
For r = LBound(ResultArr) To UBound(ResultArr)
c = c + 1
Range("A" & c) = ResultArr(r)
Next
End Sub

Regards,
Per
 
Back
Top