Saturday, October 6, 2012

VBA Word Tables - Delete Rows if Duplicate Values


Sub Delete_Rows_If_Duplicate_Values_In_Column_Of_Table()
' _____________________________________________________________
'
' This macro deletes rows in a table in a Word document
' if sequential values in a column are duplicates
' _____________________________________________________________
'
' NOTE: if comparing alphabetical values, remember that "A" is not equal to "a"
' _____________________________________________________________
'
' FIRSTLY, you need to sort your table so that duplicate values in the column you
' are interested in are below one another; then run the macro
' _____________________________________________________________
'
' This VBA macros works in Word
' _____________________________________________________________
'
Dim i, Next_Cell As Integer, The_Cell_to_Check, The_Table_to_Check As Integer

The_Table_to_Check = 1
     ' Put 1 if it's the first table, 2 if it's the second table and so on...
                         
The_Cell_to_Check = 1
     ' Put the value of the column you are checking here
                         
ActiveDocument.Tables(The_Table_to_Check).Rows(1).Cells(The_Cell_to_Check).Select

    If Selection.Information(wdWithInTable) = True Then
        Number_of_Rows = Selection.Information(wdMaximumNumberOfRows)
       Next_Cell = Val(Number_of_Rows)
    End If

 For i = 1 To Next_Cell

    If i = Next_Cell Then Exit For
 
     ActiveDocument.Tables(The_Table_to_Check).Rows(i).Cells _
     (The_Cell_to_Check).Select
     
      First_Val = Trim(Mid(Selection.Text, 1, Len(Selection.Text) - 1))
   
     ActiveDocument.Tables(The_Table_to_Check).Rows(i + 1).Cells _
     (The_Cell_to_Check).Select
     
      Second_Val = Trim(Mid(Selection.Text, 1, Len(Selection.Text) - 1))

    If First_Val = Second_Val Then
     
     Selection.SelectRow
     Selection.Rows.Delete
     i = i - 1
     Selection.MoveUp Unit:=wdLine, COUNT:=1
     Next_Cell = Next_Cell - 1
 
    End If

 Next i

End Sub

No comments:

Post a Comment

You may comment or show me other VBA tricks, but don't rest assured I'll always reply because I only have 24 hours in a day's hard work, and only a few minutes a week to update this blog... I'll try my best though...