How do I search for duplicate lines and then remove one of them? requires VBA
I was wondering if anyone knows how to remove duplicate lines. Let's say for example
A B C
1 1 3 4
2 2 6 9
3 TEST 1 2
4 TEST 1 2
5 Both 1
6 Hi 2
7 None 3 3
8 Loud 4 4
In the above example, TEST is repeated twice. In some other cases, the name may be a different kind, such as NOON, Morning, etc. And line 8 doesn't have to be the last line. I have no idea how to compare strings in order to check for duplicate names and then remove them. I need to run a macro with this and so I need VBA. If you know this, share it with me .. We will be grateful!
Attempted codes:
Sub Macro1()
Dim LastRow As Long, n As Long, rowstodelete As Long
LastRow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For n = 1 To LastRow
With Worksheets("Sheet1").Cells(n, 1)
If .Cells(n, 1) = .Cells(n + 1, 1) Then
rowstodelete = Worksheets("Sheet1").Cells(n, 1)
Rows(rowstodelete).Select
Selection.Delete Shift:=xlUp
End If
End With
Next n
End Sub
Unfortunately there was a runtime error in .Cells (n, 1). I have no idea why this is .. If you know that something can share with me or change it somehow. we are grateful!
source to share
user1204868
It is recommended to delete lines, always doing it in reverse. See this code. Also you don't need to select a cell before deleting. This will slow down your code :)
Sub Sample()
Dim LastRowcheck As Long, n1 As Long
With Worksheets("Sheet1")
LastRowcheck = .Range("A" & .Rows.Count).End(xlUp).Row
For n1 = LastRowcheck To 1 Step -1
If .Cells(n1, 1).Value = Cells(n1 + 1, 1).Value Then
.Rows(n1).Delete
End If
Next n1
End With
End Sub
Here's even better and faster .
Sub Sample()
Dim LastRowcheck As Long, n1 As Long
Dim DelRange As Range
With Worksheets("Sheet1")
LastRowcheck = .Range("A" & .Rows.Count).End(xlUp).Row
For n1 = 1 To LastRowcheck
If .Cells(n1, 1).Value = Cells(n1 + 1, 1).Value Then
If DelRange Is Nothing Then
Set DelRange = .Rows(n1)
Else
Set DelRange = Union(DelRange, .Rows(n1))
End If
End If
Next n1
If Not DelRange Is Nothing Then DelRange.Delete
End With
End Sub
Followup
any idea why removing the backward line is better? - franklin 29 seconds ago
When you delete a line, your loop For
gets confused when you adjust the given number of lines. Then you should write an additional line of code like you do to keep track of the deleted lines. It also slows down your code :) If you delete in reverse order you do not have to consider leaving the line, as it falls out of the current loop current . This way your code is faster. But as I mentioned above, if you are not using backline deletion, use the second code I gave. It's even faster.
One point that I would like to mention. If you are using Excel 2007/2010 then one line code suggested by @brettdj is the fastest :)
NTN
Sid
source to share
Guide
Bill Jelen 's website offers three methods without VBA
- All versions: Use a unique option in the advanced filter
- Xl 07/10: Use conditional formatting to mark duplicates.
- Xl 07/10: Use the Remove Duplicates icon
For (3) the equivalent VBA would be something like this (no headers) ActiveSheet.Range("$A$1:$C$100").RemoveDuplicates Columns:=1, Header:=xlNo
Handling existing duplicates
My free Duplicate Master addin will allow you
- Please select
- Colour
- List
- Delete
duplicates in both cells, entire rows (which seems to be your question), or specific columns in a row
But more importantly, it will allow you to do more complex matching than exact strings, i.e.
- Case insensitive / case sensitive search terms
- Trim / Clean Data
- Remove all spaces (including CHAR (160))
- Execute regex
- Matches any combination of columns (e.g. column A, all columns, column A, etc.)
source to share
I tried my code again and it may work well .. Thanks! I'll share it here to answer similar questions in the future!
Sub Macro1()
Dim LastRowcheck As Long, n1 As Long, rowschecktodelete As Long
LastRowcheck = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For n1 = 1 To LastRowcheck
With Worksheets("Sheet1").Cells(n1, 1)
If Cells(n1, 1) = Cells(n1 + 1, 1) Then
Worksheets("Sheet1").Cells(n1, 1).Select
Selection.EntireRow.Delete
End If
End With
Next n1
End Sub
source to share