Useful VBA Macros for Excel and Word
A compendium of some of my old VBA macros from the most annoying and simple ones to those that defy you at the end of a long day. I had to build the macros to deal with the demands of my job to manipulate strings, cells and files and this blog is a way to sort the most useful macros scattered all over my disks. I am not a professional programmer though, so I will accept absolutely no liability for any damage!
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
Subscribe to:
Post Comments (Atom)
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...