Macro Help

[Michael Koerner]

I posted the following a week or so ago in the Table NG, with no luck.
thought I might try here.

In 2003, I used to have a macro that after I ran a merge into a table, run
the macro that would, when placed in the first cell of the table:

Insert a new row,
Combine and Center (vertically and horizontally) all the cells in that row,
Put a border around the Cell and fill it with 10% grey, and set it to Bold
and enter the first Alpha Character for the whatever name was in the
beginning cell.
The macro would insert this row, insert the alpha character every time the
first letter in the first column changed. Which looked something like this

-------------------
A
------------------
Adams
Armstrong
-----------------
B
-----------------
Brown...


Unfortunately, when I inserted office 7 that macro can no longer to be
found. I have in 2007 using the create macro thingy created a macro which
will put in the new row wherever I put the cursor and run the macro. Would
really like to automate the process again if possible. any help would be
greatly appreciated. TIA

 

[Doug Robbins - Word MVP]

The following will do it:

Dim Init As String
Dim newrow As Row
Dim initrng As Range
Dim dtable As Table
Set dtable = Selection.Tables(1)
Set initrng = Selection.Range
Init = initrng.Characters(1)
Set newrow = dtable.Rows.Add(BeforeRow:=Selection.Rows(1))
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Text = Init
.Range.Font.Bold = True
.Range.Shading.BackgroundPatternColor = wdColorGray10
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Michael Koerner]

Doug;

Thanks very much. It works like you say only after it inserts the row, and
does it's magic and enters the alpha character. It does not continue through
the table and insert the rows automatically every time there is a change in
the alpha character in the first column, which in this case is LastName.

 

[Doug Robbins - Word MVP]

Use

Dim i As Long, j As Long
Dim Init As String
Dim newrow As Row
Dim initrng As Range
Dim dtable As Table
Set dtable = Selection.Tables(1)
j = dtable.Rows.Count
Init = dtable.Cell(j, 1).Range.Characters(1)
For i = j To 1 Step -1
Set initrng = dtable.Cell(i, 1).Range
If initrng.Characters(1) <> Init Then
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment =
wdAlignParagraphCenter
.Range.Text = Init
.Range.Font.Bold = True
.Range.Shading.BackgroundPatternColor = wdColorGray10
End With
Init = initrng.Characters(1)
End If
Next i
Set newrow = dtable.Rows.Add(BeforeRow:=dtable.Rows(i + 1))
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Text = Init
.Range.Font.Bold = True
.Range.Shading.BackgroundPatternColor = wdColorGray10
End With

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Jean-Guy Marcil]

Michael Koerner was telling us:
Michael Koerner nous racontait que :

Doug;

Thanks very much. It works like you say only after it inserts the
row, and does it's magic and enters the alpha character. It does not
continue through the table and insert the rows automatically every
time there is a change in the alpha character in the first column,
which in this case is LastName.

Then this slight modification to Doug's code should do the trick:

'_______________________________________
Dim Init As String
Dim newrow As Row
Dim dtable As Table
Dim i As Long

If Not Selection.Information(wdWithInTable) Then
MsgBox "You must position the cursor in a table.", _
vbExclamation, "Error"
Exit Sub
End If

Set dtable = Selection.Tables(1)

With dtable
i = 1
Do
If UCase(.Rows(i).Cells(1).Range.Characters(1)) _
<> Init Then
Init = UCase(.Rows(i).Cells(1).Range.Characters(1))
Set newrow = .Rows.Add(.Rows(i))
With newrow
.Cells.Merge
.Cells(1).Range.ParagraphFormat _
.Alignment = wdAlignParagraphCenter
.Range.Text = Init
.Range.Font.Bold = True
.Range.Shading _
.BackgroundPatternColor = wdColorGray10
End With
End If
i = i + 1
Loop While i <= .Rows.Count
End With
'_______________________________________

You should probably add code to handle empty cells and if there are
vertically merged cells, all bets are off!


--

Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

 

[Michael Koerner]

Right on, thanks very much.

 

[Michael Koerner]

Jean-Guy

Thanks very much, both your version, and Doug's work perfectly Greatly
appreciated