PDA

View Full Version : [SOLVED:] Macro to merge two adjacent table rows based on matching criteria in column 1



misery1912
08-26-2018, 07:48 PM
Hello,

I've never used VBA so I've been scouring forums all day looking for a macro to help me merge two adjacent table rows based on matching dates in the first column. Ideally it would merge the cells in column 3, then delete the cells in columns 1 and 2 of the second row.

So my table would go from this:



4-26-1996
los angeles
long beach


7-11-1996
los angeles
los angeles


7-11-1996
not available
Burbank
Hawthorne


9-5-1997
los angeles
Altadena



To this:



4-26-1996
los angeles
long beach


7-11-1996
los angeles
los angeles
Burbank
Hawthorne


9-5-1997
los angeles
Altadena








Based on other posts I located I began writing it with this:

Sub mergerows()
With ActiveDocument.Tables(1)
.Cell(Row:=1, Column:=1).merge _
MergeTo:=.Cell(Row:=2, Column:=1)
End With
End Sub

However I quickly realized I need some sort of conditional if/then line to find the matching rows, and the attempts I've made based on code I've found in other posts haven't come close.

Any assistance would be greatly appreciated.

macropod
08-27-2018, 02:39 AM
Try:

Sub Demo()
Application.ScreenUpdating = False
Dim r As Long, c As Long
With ActiveDocument.Tables(1)
For r = .Rows.Count - 1 To 1 Step -1
If .Cell(r, 1).Range.Text = .Cell(r + 1, 1).Range.Text Then
.Cell(r + 1, 1).Range.Text = vbNullString
.Cell(r + 1, 2).Range.Text = vbNullString
For c = 1 To .Columns.Count
.Cell(r, c).Merge .Cell(r + 1, c)
Next
End If
Next
End With
Application.ScreenUpdating = True
End Sub