Alternate grey/red shading with subtitles getting shaded differently(Word table)

[andreas]

Dear Experts:

I got a telephone list/table with the following make-up:

- Each name and corresponding phone number has got its own row.
- The letters A-Z also have their own rows and are formatted bold
- First name, last name is entered in one table cell
- Phone numbers are entered in the table cells next to the "name" cell

With any number rows of the table SELECTED would like the table to
acquire the following FORMATTING:

Rows A, B,C to Z (formatted bold) should have a grey shaded fill (RGB
value 133, 133, 133)
Rows immediately following these subtitles (A-Z) should be shaded
alternately red (239, 211, 210) and grey (133, 133, 133) with the
condition that the alternate cell shading below the subtitles (A to Z)
should always start with a red fill (239, 211, 210).

As I stated above the macro should feature the SELECTION Object.

Help is much appreciated. Thank you very much in advance for your
always terrific help.

Regards, Andreas

SAMPLE TELEPHONE LIST:

A (formatted bold)
Adam, John 069-4553
Atkins, Robert 074-3444
etc.
B (formatted bold)
Bernard, Joe 045-4432
Batton, Jim 743-3983
Beacon, George 345-3597
etc.
C (formatted bold)
Carlos, Santos 435-3993
etc.

 

[Graham Mayor]

A bit of a lash up - but the following should work;

Dim oRow As Row
Dim oRng As Range
Dim bNew As Boolean
On Error Resume Next
bNew = False
With ActiveDocument.Tables(1)
For Each oRow In .Rows
Set oRng = oRow.Cells(1).Range
oRng.End = oRng.End - 1
If oRng.Characters.Count = 1 And _
Asc(oRng.Characters(1)) > 64 And _
Asc(oRng.Characters(1)) < 91 Then
oRng.Bold = True
oRow.Shading.BackgroundPatternColor = _
RGB(133, 133, 133)
End If
Next oRow
For i = 1 To .Rows.Count
If .Rows(i).Shading.BackgroundPatternColor = _
RGB(133, 133, 133) Then
i = i + 1
bNew = True
End If
If bNew = True Then
.Rows(i).Shading.BackgroundPatternColor = _
RGB(239, 211, 210)
bNew = False
i = i + 1
End If
If bNew = False Then
.Rows(i).Shading.BackgroundPatternColor = _
RGB(133, 133, 133)
bNew = True
End If
Next i
End With

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[andreas]

A bit of a lash up - but the following should work;

Dim oRow As Row
Dim oRng As Range
Dim bNew As Boolean
On Error Resume Next
bNew = False
With ActiveDocument.Tables(1)
    For Each oRow In .Rows
        Set oRng = oRow.Cells(1).Range
            oRng.End = oRng.End - 1
            If oRng.Characters.Count = 1 And _
            Asc(oRng.Characters(1)) > 64 And _
            Asc(oRng.Characters(1)) < 91 Then
                oRng.Bold = True
                oRow.Shading.BackgroundPatternColor = _
                RGB(133, 133, 133)
            End If
    Next oRow
    For i = 1 To .Rows.Count
        If .Rows(i).Shading.BackgroundPatternColor = _
        RGB(133, 133, 133) Then
            i = i + 1
            bNew = True
        End If
        If bNew = True Then
            .Rows(i).Shading.BackgroundPatternColor = _
            RGB(239, 211, 210)
            bNew = False
            i = i + 1
        End If
        If bNew = False Then
            .Rows(i).Shading.BackgroundPatternColor = _
            RGB(133, 133, 133)
            bNew = True
        End If
    Next i
End With

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor -  Word MVP

My web sitewww.gmayor.com
Word MVP web sitehttp://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>















- Show quoted text -

Dear Graham,

what a terrific help! It works as desired. Thank you very much!

Regards, Andreas