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!

+3


source to share


5 answers


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

+6


source


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

enter image description here

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.) enter image description here
+4


source


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

      

0


source


The easiest way to do it in VBA (2007 or higher):

Worksheet("Sheet1").Range("A1").CurrentRegion.RemoveDuplicates(Array(1, 2, 3))

Depending on the format of the worksheet, you may need to adjust Range("A1").CurrentRegion

to the data range ...

0


source


It seems to me we need to sort the data first before running this macro in order to completely remove duplicates.

-3


source







All Articles