Deleting duplicate rows in a table

Article contributed by Ibby

Method 1

The following macros will delete duplicate rows (rows with the same text in column 1) in a sorted table. The first is case-sensitive (ie: it will not delete rows where the text is the same but the case of the text is different). The second will delete duplicates even if the case of the text is different.

Option Explicit

Public Sub DeleteDuplicateRows()

' Deletes Rows with duplicate text in first column.
' It will not delete identical entries if the case
' of the text is different.

  Dim oTable As Table
  Dim oRow As Range
  Dim oNextRow As Range
  Dim i As Long

  ' Specify which table you want to work on.
  Set oTable = ActiveDocument.Tables(1)

  ' Set an object variable to the first row.
  Set oRow = oTable.Rows(1).Range

  ' Turn off screen updating – reduces screen flicker
  ' and lets the code run faster
  Application.ScreenUpdating = False

  For i = 1 To oTable.Rows.Count - 1

      ' Set an object variable to the next row.
      Set oNextRow = oRow.Next(wdRow)

      ' Compare the text in the first column of the two rows.
      If oRow.Cells(1).Range = oNextRow.Cells(1).Range Then
          ' If text is identical, delete the second row
          oNextRow.Rows(1).Delete
      Else
          ' If not identical, move to the next row.
          Set oRow = oNextRow
      End If

  Next i

  ' Turn screen updating back on.
  Application.ScreenUpdating = True

End Sub
--------------------------------------

Option Explicit

Public Sub DeleteDuplicateRows()

  ' Deletes Rows with duplicate text in first column.
  ' It will delete identical entries even if the case
  ' of the text is different.

  Dim oTable As Table
  Dim oRow As Range
  Dim oNextRow As Range
  Dim i As Long
  Dim txtCell As String
  Dim txtCellNext As String

  Set oTable = ActiveDocument.Tables(1)
  Set oRow = oTable.Rows(1).Range

  Application.ScreenUpdating = False

   For i = 1 To oTable.Rows.Count - 1

      Set oNextRow = oRow.Next(wdRow)

      txtCell = LCase(oRow.Cells(1).Range.Text)
      txtCellNext = LCase(oNextRow.Cells(1).Range.Text)

      If txtCell = txtCellNext Then
          oNextRow.Rows(1).Delete
      Else
          Set oRow = oNextRow
      End If

  Next i

  Application.ScreenUpdating = True

End Sub
-------------------------------------
  

Method 2

If you only want to delete rows that have identical text to each other (in all columns), then, depending on the size of the table; and assuming it contains no merged cells; the fastest way is often to convert the table to text, then use a wildcard Find & Replace, before converting the text back to a table.

This method is described in the article: Finding and replacing characters using wildcards, in the section Example 4: Duplicate paragraphs (and rows).


Click to view Terms of Use page

Click to view Disclaimer page