How to remove duplicate rows from table in Word document?
AuthorSun•Last modified
In Word document, there may be some tables with duplicate rows which you want to remove and keep the first appearance one sometimes. In this case, you can choose to remove the duplicate ones one by one manually, also you can choose to use the VBA code.
1. Place the cursor at the table you want to remove the duplicate rows from, press Alt + F11 keys to enable the Microsoft Visual Basic for Applications window.
2. Click Insert > Module to create a new Module.
3. Copy below codes and paste them to the new Module script.
VBA: Remove duplicate rows from table in Word
Public Sub DeleteDuplicateRows2()
'UpdatebyExtendoffice20181011
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 = xRow.Text
xNum = -1
If xDic.Exists(xStr) Then
' xTable.Rows(I).Delete
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
' xTable.Rows(I).Delete
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
4. Press F5 key to run the code, then all duplicate rows will be removed.
Note: Above code is case sensitive, if you want to remove duplicate rows in case insensitive, you can use below code:
Public Sub DeleteDuplicateRows2()
'UpdatebyExtendoffice20181011
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
' xTable.Rows(I).Delete
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 = UCase(xRow.Text)
xNum = -1
If xDic.Exists(xStr) Then
' xTable.Rows(I).Delete
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
If you want to remove duplicate rows in all tables of the document, place the cursor in any place of document outside the table, then apply one of above codes.
Office Tab: Brings tabbed interfaces to Word, Excel, PowerPoint...
Do More in Less Time with AI-Enhanced Kutools for Word
Kutools for Word isn't just a set of tools - it's a smart solution designed to boost your productivity. With AI-driven capabilities and the most essential features, Kutools helps you accomplish more in less time:
Summarize, rewrite, compose, and translate content instantly.
Proofread text in real-time with grammar, punctuation, and style suggestions as you write.
Rephrase and translate content while keeping layout, style, and structure untouched.
Translate your content into over 40 languages with ease, expanding your reach globally.
Receive instant help and intelligent insights based on your current document content.
Ask how to complete a task - like removing section breaks - and the AI will guide you or do it for you.
Redact sensitive or confidential information in seconds to ensure complete privacy.
All tools work seamlessly inside Word, always within reach.
Create, refine, translate, summarize and secure documents effortlessly.
Improve grammar, clarity, and tone as you write in real time.
Rephrase and translate content with no layout or formatting changes.
Ask how to complete a task - like removing section breaks - and the AI will guide you or do it for you.
All tools work seamlessly inside Word, always within reach.
