Delete Unique Records using a Macro

Question

I have data in the ranges of A1:D1000.  I want to be able to use a Macro to delete all the rows that have any unique records that are in column "A" .  What is the VBA for that?

Thanks in Advance.

Marc

Answer 1

Hi Marc:

try:

Sub shortma()

Dim r As Range

For i = 1000 To 1 Step -1

    Set r = Cells(i, 1)

    If Application.WorksheetFunction.CountIf(Range("A1:A1000"), r.Value) = 1 Then

        r.EntireRow.Delete

    End If

Next

End Sub

So if we start with:

7	0.68879	0.298145	0.035567
1	0.745507	0.021789	0.919828
8	0.774253	0.874487	0.676963
9	0.111728	0.300472	0.681414
2	0.614545	0.744697	0.515091
8	0.480754	0.361524	0.249687
3	0.281722	0.784156	0.751329
3	0.393773	0.450899	0.035249
6	0.795477	0.276205	0.57035
2	0.718644	0.249926	0.808067
4	0.668782	0.689195	0.730714
5	0.58335	0.354875	0.163278
3	0.62055	0.136787	0.031916
2	0.160409	0.636593	0.361749
8	0.956556	0.28918	0.951877
4	0.913681	0.989438	0.408853
5	0.821071	0.076258	0.59916
7	0.674966	0.784255	0.741872
9	0.163926	0.905668	0.046216
3	0.21487	0.164998	0.706453

The macro will produce:

7	0.68879	0.298145	0.035567
8	0.774253	0.874487	0.676963
9	0.111728	0.300472	0.681414
2	0.614545	0.744697	0.515091
8	0.480754	0.361524	0.249687
3	0.281722	0.784156	0.751329
3	0.393773	0.450899	0.035249
2	0.718644	0.249926	0.808067
4	0.668782	0.689195	0.730714
5	0.58335	0.354875	0.163278
3	0.62055	0.136787	0.031916
2	0.160409	0.636593	0.361749
8	0.956556	0.28918	0.951877
4	0.913681	0.989438	0.408853
5	0.821071	0.076258	0.59916
7	0.674966	0.784255	0.741872
9	0.163926	0.905668	0.046216
3	0.21487	0.164998	0.706453

This is because both the "1" and the "6" are "unique" That is they occur only once!

Answer 2

Hi,

So if a record appears only once in Col A then you want to delete it keeping only those records that appear more than once. Try this

Sub delete_Me()

Dim LastRow As Long, x As Long, MyRange As Range

LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row

Set MyRange = Range("A1:A" & LastRow)

For x = LastRow To 1 Step -1

    If WorksheetFunction.CountIf(MyRange, Cells(x, 1)) = 1 Then

        Rows(x).Delete

    End If

Next

End Sub

Answer 3

Hi,

To make the code work on Col C it would look like this

Sub delete_Me()

Dim LastRow As Long, x As Long, MyRange As Range

LastRow = Cells(Cells.Rows.Count, "C").End(xlUp).Row

Set MyRange = Range("C1:C" & LastRow)

For x = LastRow To 1 Step -1

If WorksheetFunction.CountIf(MyRange, Cells(x, 3)) = 1 Then

Rows(x).Delete

End If

Next

End Sub

Answer 4

Mike,

this was very useful; however, how would the code have to be ammended to look into a value in another column?  My unique value would appear in column C.   I could add to the code and have the column moved to column a, perform the function then move the column back to its original position.  I would rather use the code, because I am sure it will be helpful for other projects.