• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 689
  • Last Modified:

Alternate grey shading for selected rows of a table

Dear Experts:

with x rows of a table selected I would like to activate a macro that ...

... alternately shades the selected rows grey. The grey shading should begin on the uppermost selected row.

I GOT a macro that does this alternate shading much more comfortable (see macro below <TblAltShadingGrey>), but as soon as the macro hits vertically merged cells, it throws an error message. Therefore I would like to be able to apply alternate grey shading (only) to selected rows.

I am also aware that a user-defined table style could do the above job (alternate grey shading) very easily. But there are a couple of Word 2000 documents where I have to perform these tasks.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas


Sub TblAltShadingGrey()

   Dim oRow As row
   Dim rng As Word.range
   Dim tbl As Table
   Dim StartRow As Long
   Dim ShadedRow As Boolean
   
   
If Not Selection.Information(wdWithInTable) Then
    MsgBox "Please place the cursor into the table", vbOKOnly + vbCritical, "Alternate Grey Shading for selected Table"
     Exit Sub
End If


   StartRow = InputBox("Grey Shading: Enter starting row:", "Alternate Grey Shading")
   
   Set tbl = Selection.Tables(1)
   Set rng = tbl.range

   For Each oRow In tbl.rows
      If oRow.Index >= StartRow Then
         ShadedRow = Not ShadedRow
         If ShadedRow Then
            oRow.Cells.Shading.BackgroundPatternColor = RGB(225, 225, 225)
         Else
            oRow.Cells.Shading.BackgroundPatternColor = wdColorAutomatic
         End If
      End If
   Next
   
 End Sub

Open in new window

0
AndreasHermle
Asked:
AndreasHermle
  • 5
  • 2
2 Solutions
 
Chris BottomleyCommented:
Hello AndreasHermle,

Try the following change ... it assumes you have selected the rows to be processed.

Regards,

chris_bottomley
Sub TblAltShadingGrey()

   Dim oRow As Row
   Dim rng As Word.Range
'   Dim tbl As Table
   Dim StartRow As Long
   Dim ShadedRow As Boolean
   
   
If Not Selection.Information(wdWithInTable) Then
    MsgBox "Please place the cursor into the table", vbOKOnly + vbCritical, "Alternate Grey Shading for selected Table"
     Exit Sub
End If



   'StartRow = InputBox("Grey Shading: Enter starting row:", "Alternate Grey Shading")
   
   'Set tbl = Selection.Tables(1)
   Set rng = Selection.Range

   For Each oRow In rng.Rows
      If oRow.Index >= StartRow Then
         ShadedRow = Not ShadedRow
         If ShadedRow Then
            oRow.Cells.Shading.BackgroundPatternColor = RGB(225, 225, 225)
         Else
            oRow.Cells.Shading.BackgroundPatternColor = wdColorAutomatic
         End If
      End If
   Next
   
 End Sub

Open in new window

0
 
AndreasHermleAuthor Commented:
Hi Chris,

thank you very much for your swift help.

I am afraid to tell you that the macro does not work on tables that contain vertically merged cells, even if the vertically merged cells are not part of the selection (selected rows). On "clean tables", i.e. tables without any vertically merged cells, the macro works fine.

The error (5991 =  Cannot access individual rows in this collection because the table
has vertically merged cells)  occurs on code line 22 (For each oRow in rng.rows)

Help is much appreciated. Thank you very much in advance. Regards, Andreas
0
 
Chris BottomleyCommented:
Apologies I latched onto the select and didn't realise the issue affected the table rathe than s.

I'll look further

Chris
0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Chris BottomleyCommented:
Changed the direction to cells ... try this but note that if a merged cell is found then the cell is treated as one.

Chris
Sub TblAltShadingGrey()

   Dim cel As Cell
   Dim rng As Word.Range
'   Dim tbl As Table
   Dim StartRow As Long
   Dim ShadedRow As Boolean
   Dim rw As Integer
   Dim col As Integer
   
   
If Not Selection.Information(wdWithInTable) Then
    MsgBox "Please place the cursor into the table", vbOKOnly + vbCritical, "Alternate Grey Shading for selected Table"
     Exit Sub
End If



   'StartRow = InputBox("Grey Shading: Enter starting row:", "Alternate Grey Shading")
   
   'Set tbl = Selection.Tables(1)
   Set rng = Selection.Range

    For rw = Selection.Cells(1).RowIndex To Selection.Cells(Selection.Cells.Count).RowIndex
        ShadedRow = Not ShadedRow
        For col = 1 To Selection.Tables(1).Columns.Count
            Set cel = Selection.Tables(1).Cell(rw, col)
            If ShadedRow Then
                cel.Shading.BackgroundPatternColor = RGB(225, 225, 225)
            Else
                cel.Shading.BackgroundPatternColor = wdColorAutomatic
            End If
        Next
    Next
   
 End Sub

Open in new window

0
 
Chris BottomleyCommented:
And out of interest the following applies the format to the table within the constraint that the vertically merged cells are set by the first row of the merge.

Chris
Sub TblAltShadingGrey_CRB()
Dim cel As Cell
Dim StartRow As Long
Dim ShadedRow As Boolean
Dim rw As Integer
Dim col As Integer
   
   
    If Not Selection.Information(wdWithInTable) Then
        MsgBox "Please place the cursor into the table", vbOKOnly + vbCritical, "Alternate Grey Shading for selected Table"
         Exit Sub
    End If

    For rw = 1 To Selection.Tables(1).Rows.Count
        ShadedRow = Not ShadedRow
        For col = 1 To Selection.Tables(1).Columns.Count
            Set cel = Nothing
            On Error Resume Next
            Set cel = Selection.Tables(1).Cell(rw, col)
            On Error GoTo 0
            If Not cel Is Nothing Then
                If ShadedRow Then
                    cel.Shading.BackgroundPatternColor = RGB(225, 225, 225)
                Else
                    cel.Shading.BackgroundPatternColor = wdColorAutomatic
                End If
            End If
        Next
    Next
   
 End Sub

Open in new window

0
 
AndreasHermleAuthor Commented:
Chris:

   Sir, this is simply great!

   Thank you very much for your terrific help. I really appreciate your professionalism.

Best Regards, Andreas
0
 
Chris BottomleyCommented:
Glad to help ... and thank you for opening my eyes to the merged cell impact on macros.

Chris
0

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

  • 5
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now