Home » Blog » How to Delete Duplicate Rows from a Table in a Word Document?

Blog

How to Delete Duplicate Rows from a Table in a Word Document?

AdminP p

December 11, 2023

9 Views 0

SaveSavedRemoved 0

In a Word document, there might be tables with duplicate rows that you want to remove while preserving the first occurrence. You can manually choose to delete each duplicate, or you can use VBA (Visual Basic for Applications) to automate the process.

Delete Duplicate Rows from a Table in Word

1. Place the cursor inside the table from which you want to remove duplicate rows.
2. Press Alt + F11 to open the Microsoft Visual Basic for Applications window.
3. Click Insert > Module to create a new module for your code.

How to Delete Duplicate Rows from a Table in a Word Document

4. Copy and paste the following code into the new module.
   Public Sub DeleteDuplicateRows2()
   Dim xTable As Table
   Dim xRow As Range
   Dim xStr As String
   Dim xDic As Object
   Dim I, J, KK, xNum As LongIf ActiveDocument.Tables.Count = 0 Then
   MsgBox “This document does not have table(s).”, vbInformation, “Kutools for Word”
   Exit Sub
   End If

   Application.ScreenUpdating = False
   Set xDic = CreateObject(“Scripting.Dictionary”)

   If Selection.Information(wdWithInTable) Then
   Set xTable = Selection.Tables(1)
   For I = xTable.Rows.Count To 1 Step -1
   Set xRow = xTable.Rows(I).Range
   xStr = xRow.Text
   xNum = -1
   If xDic.Exists(xStr) Then
   For J = xTable.Rows.Count To 1 Step -1
   If (xStr = xTable.Rows(J).Range.Text) And (J <> I) Then
   xNum = xNum + 1
   xTable.Rows(J).Delete
   End If
   Next
   I = I – xNum
   Else
   xDic.Add xStr, I
   End If
   Next
   Else
   For I = 1 To ActiveDocument.Tables.Count
   Set xTable = ActiveDocument.Tables(I)
   xNum = -1
   xDic.RemoveAll
   For J = xTable.Rows.Count To 1 Step -1
   Set xRow = xTable.Rows(J).Range
   xStr = xRow.Text
   xNum = -1
   If xDic.Exists(xStr) Then
   For KK = xTable.Rows.Count To 1 Step -1
   If (xStr = xTable.Rows(KK).Range.Text) And (KK <> J) Then
   xNum = xNum + 1
   xTable.Rows(KK).Delete
   End If
   Next
   J = J – xNum
   Else
   xDic.Add xStr, J
   End If
   Next
   Next
   End If

   Application.ScreenUpdating = True
   End Sub
   

5. Press F5 to run the code, and all duplicate rows will be deleted.

Note: The code is case-sensitive. If you want to delete case-insensitive duplicate rows, use the modified code below:

Public Sub DeleteDuplicateRows2()
Dim xTable As Table
Dim xRow As Range
Dim xStr As String
Dim xDic As Object
Dim I, J, KK, xNum As Long

If ActiveDocument.Tables.Count = 0 Then
MsgBox “This document does not have table(s).”, vbInformation, “Kutools for Word”
Exit Sub
End If

Application.ScreenUpdating = False
Set xDic = CreateObject(“Scripting.Dictionary”)

If Selection.Information(wdWithInTable) Then
Set xTable = Selection.Tables(1)
For I = xTable.Rows.Count To 1 Step -1
Set xRow = xTable.Rows(I).Range
xStr = UCase(xRow.Text)
xNum = -1
If xDic.Exists(xStr) Then
For J = xTable.Rows.Count To 1 Step -1
If (xStr = UCase(xTable.Rows(J).Range.Text)) And (J <> I) Then
xNum = xNum + 1
xTable.Rows(J).Delete
End If
Next
I = I – xNum
Else
xDic.Add xStr, I
End If
Next
Else
For I = 1 To ActiveDocument.Tables.Count
Set xTable = ActiveDocument.Tables(I)
xNum = -1
xDic.RemoveAll
For J = xTable.Rows.Count To 1 Step -1
Set xRow = xTable.Rows(J).Range
xStr = UCase(xRow.Text)
xNum = -1
If xDic.Exists(xStr) Then
For KK = xTable.Rows.Count To 1 Step -1
If (xStr = UCase(xTable.Rows(KK).Range.Text)) And (KK <> J) Then
xNum = xNum + 1
xTable.Rows(KK).Delete
End If
Next
J = J – xNum
Else
xDic.Add xStr, J
End If
Next
Next
End If

Application.ScreenUpdating = True
End Sub

If you want to delete duplicate rows across all tables in the document, place the cursor anywhere outside any table and apply one of the above codes.