CODEWITHSUNDEEP
vbaexcelduplicates
mks212
mks212

Reputation: 921

Delete Rows With Duplicate Data VBA

I am struggling with something that should be fairly straightforward, however, I have read at least 15 methods of doing this and cannot seem to get it to work.

Here is a sample dataset:

9:30:01 584.7
9:30:01 590
9:30:01 595
9:30:02 584.51
9:30:03 584.62
9:30:04 584.44
9:30:05 584.05

I only want one row per second, so of the first 3 rows, only one needs to stay. I don't care if it is the first or the last, but the code I have been using keeps the last, 595 in this case.

The way I am doing it is with a for loop that clears the contents of the row that has the same time as the row below it. I then sort the entire range.

I imagine there is a simpler way to simply delete the extra row from the get go. However, when I use delete on the range, instead of clear, it won't remove all of the duplicate rows.

Here is what I want the data to look like:

9:30:01 595
9:30:02 584.51
9:30:03 584.62
9:30:04 584.44
9:30:05 584.05

I need this to happen for the entire sheet. The time is Column B and the values are column C.

Here is the code I am using,

LastRow = ActiveSheet.UsedRange.row - 1 + _
    ActiveSheet.UsedRange.Rows.Count

For RowNum = 2 To LastRow
    If (Range("B" & RowNum) = Range("B" & RowNum + 1)) Then
    Range("B" & RowNum).EntireRow.Clear
    End If
Next RowNum

Range("A2:C" & LastRow).Sort key1:=Range("B2:B" & LastRow), _
order1:=xlAscending, Header:=xlNo

Upvotes: 2

Views: 24231

Answers (2)

teylyn
teylyn

Reputation: 35915

Don't loop. Use RemoveDuplicates. Way faster than any loop. One line of code.

Sub test()
    ActiveSheet.Range("B:C").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

Edit: screenshots

BEFORE

enter image description here

AFTER

enter image description here

Edit: Does not work in Excel 2011 for Mac (go figure).

Upvotes: 10

Jzz
Jzz

Reputation: 739

This should do the trick:

Sub jzz()
Dim i As Long
For i = 1 To Cells.SpecialCells(xlLastCell).Row 'loop from row 1 to last row
    If Cells(i, 1) <> vbNullString Then 'check if something is in the cell
        If Cells(i, 1) = Cells(i + 1, 1) Then 'check if cell is the same as next cell
            Cells(i + 1, 1).EntireRow.Delete 'if so; delete
            i = i - 1 'go back one row
        End If
    End If
Next i
End Sub

Another option is to go from the bottom up, like so:

Sub jzz()
Dim i As Long
For i = Cells.SpecialCells(xlLastCell).Row to 1 step -1'loop from last row to row 1
    If Cells(i, 1) <> vbNullString Then 'check if something is in the cell
        If Cells(i, 1) = Cells(i + 1, 1) Then 'check if cell is the same as next cell
            Cells(i + 1, 1).EntireRow.Delete 'if so; delete
        End If
    End If
Next i
End Sub

what you prefer to use if personal. Please consider the answer of teylyn as well, in this situation, it is very usable.

Upvotes: 2

Related Questions