Alternate Row Shading with a Catch

Good morning, VBA Brain Trust!

I hope you can help me. I have the following VBA code (TableMarking) that has worked for the past 15 years or so. Now, I need to update it so there is alternate row shading. This shading would have to begin with Row 3 and stop at the second to last row. I have attached an example of an end result table (Table_End_Result.docx). Each table I would need to format using these macros is different as far as number of rows and columns.

I searched online and came across the ShadeTableRows code (by Macropod), which is also shown below. With my limited VBA knowledge/abilities, I do not know how to modify it such that it will shade all rows except the first two and the very last.

Is there a way to combine the two subroutines? If not, is there a way to update ShadeTableRows so that it will only shade the rows I select? Although it would be more convenient to run one shortcut, I am not opposed to running two. I do not want to complicate matters as I am looking for the easiest solution. I would be thrilled with anything that gets to the end result.


Sub TableMarking()

Dim objTable As Table
Dim myRange As Range

For Each objTable In Selection.Tables
With objTable
.RightPadding = 5
.LeftPadding = 5
.TopPadding = 0
.BottomPadding = 0
.Rows.SpaceBetweenColumns = CentimetersToPoints(0.2)
.Rows.AllowBreakAcrossPages = False
.Rows.Alignment = wdAlignRowCenter
.Rows.HeightRule = wdRowHeightAuto
.Shading.Texture = wdTextureSolid
.Shading.ForegroundPatternColor = wdColorWhite
.Borders.InsideLineStyle = wdLineStyleSingle
.Borders.InsideLineWidth = wdLineWidth050pt
.Borders.OutsideLineStyle = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth050pt
.Borders.InsideColor = wdColorGray35
.Borders.OutsideColor = wdColorGray35
.Range.Style = ActiveDocument.Styles("Table Body")
.Range.Font.Reset
.Range.ParagraphFormat.Reset
.Range.Cells.VerticalAlignment = wdAlignVerticalTop

'Add (TBD) row – top left
Set myRange = objTable.Rows(1).Range
objTable.Rows(1).Select
Selection.InsertRowsAbove
Selection.Cells.Merge
Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone
Selection.Borders.OutsideLineStyle = wdLineStyleNone
Selection.Style = ActiveDocument.Styles("Table Body")
Selection.TypeText Text:="(TBD)"

With .Rows(2) 'Style the header row
.Range.Style = ActiveDocument.Styles("Table Heading")
.Cells.VerticalAlignment = wdAlignVerticalTop
.Shading.Texture = wdTextureNone
.Shading.ForegroundPatternColor = wdColorAutomatic
.Shading.BackgroundPatternColor = wdColorGray
.Borders.InsideLineStyle = wdLineStyleSingle
.Borders.InsideLineWidth = wdLineWidth050pt
.Borders.OutsideLineStyle = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth050pt
.Borders.InsideColor = wdColorBlack
.Borders.OutsideColor = wdColorBlack
.Borders(wdBorderTop).LineStyle = wdLineStyleSingle
.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
.Borders(wdBorderTop).LineWidth = wdLineWidth050pt
.Borders(wdBorderBottom).LineWidth = wdLineWidth050pt
.Borders(wdBorderTop).Color = wdColorGrayBlack
.Borders(wdBorderBottom).Color = wdColorBlack
End With 'end header row style

'Add (TBD) row – bottom right
Set myRange = objTable.Rows(.Rows.Count).Range
objTable.Rows(.Rows.Count).Select
Selection.InsertRowsBelow
Selection.Cells.Merge
Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
Selection.Borders.OutsideLineStyle = wdLineStyleNone
Selection.Style = ActiveDocument.Styles("Table Body")
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.TypeText Text:="(TBD)"

With .Rows(.Rows.Count - 1) 'last data row in the table
.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
.Borders(wdBorderBottom).LineWidth = wdLineWidth050pt
.Borders(wdBorderBottom).Color = wdColorBlack
.Borders.InsideLineStyle = wdLineStyleSingle
.Borders.InsideLineWidth = wdLineWidth050pt
.Borders.InsideColor = wdColorBlack
End With 'end last data row settings

End With
Next objTable

End If
End Sub


Sub ShadeTableRows()

Dim i As Integer

With Selection
If Not .Information(wdWithInTable) Then Exit Sub
With .Tables(1)
For i = 1 To .Rows.Count
With .Rows(i).Shading
If i Mod 2 = 0 Then
.BackgroundPatternColor = wdColorGray15
Else
.BackgroundPatternColor = wdColorAutomatic
End If
End With
Next
End With
End With

End Sub

[/CODE]

I have continued to work on my problem throughout the day, and I *believe* I have come up with a workaround. If I run Macropod’s ShadeTableRows sub first and call on the second macro, TableMarking, I get the desired result. I made some other minor tweaks, as well. I have posted the new VBA code below.

If there a better, more efficient way to get to the desired result, I would welcome your help and expertise.

Thank you in advance for taking a look at this for me.


Sub ShadeTableRows()

Dim i As Integer

With Selection
If Not .Information(wdWithInTable) Then Exit Sub
With .Tables(1)
For i = 1 To .Rows.Count
With .Rows(i).Shading
If i Mod 2 = 0 Then
.BackgroundPatternColor = wdColorGray15
Else
.BackgroundPatternColor = wdColorAutomatic
End If
End With
Next
End With
End With

Call TableMarking

End Sub

Sub TableMarking()


Dim objTable As Table
Dim myRange As Range

For Each objTable In Selection.Tables
With objTable
.RightPadding = 5
.LeftPadding = 5
.TopPadding = 0
.BottomPadding = 0
.Rows.SpaceBetweenColumns = CentimetersToPoints(0.2)
.Rows.AllowBreakAcrossPages = False
.Rows.Alignment = wdAlignRowCenter
.Rows.HeightRule = wdRowHeightAuto
'.Shading.Texture = wdTextureSolid - Doesn't work w/called sub
'.Shading.ForegroundPatternColor = wdColorWhite - Doesn't work with called sub
.Borders.InsideLineStyle = wdLineStyleSingle
.Borders.InsideLineWidth = wdLineWidth050pt
.Borders.OutsideLineStyle = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth050pt
.Borders.InsideColor = wdColorBlack
.Borders.OutsideColor = wdColorBlack35
.Range.Style = ActiveDocument.Styles("Table Body")
.Range.Font.Reset
.Range.ParagraphFormat.Reset
.Range.Cells.VerticalAlignment = wdAlignVerticalTop

'Add (TBD) row - top left
Set myRange = objTable.Rows(1).Range
objTable.Rows(1).Select
Selection.InsertRowsAbove
Selection.Cells.Merge
Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone
Selection.Borders.OutsideLineStyle = wdLineStyleNone
Selection.Style = ActiveDocument.Styles("Table Body")
Selection.TypeText Text:="(TBD)"

With .Rows(2) 'Style the header row
.Range.Style = ActiveDocument.Styles("Table Heading")
.Range.Rows.HeadingFormat = True
.Cells.VerticalAlignment = wdAlignVerticalTop
.Shading.Texture = wdTextureNone
.Shading.ForegroundPatternColor = wdColorAutomatic
.Shading.BackgroundPatternColor = wdColorGray
.Borders.InsideLineStyle = wdLineStyleSingle
.Borders.InsideLineWidth = wdLineWidth050pt
.Borders.OutsideLineStyle = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth050pt
.Borders.InsideColor = wdColorWhite
.Borders.OutsideColor = wdColorBlack
.Borders(wdBorderTop).LineStyle = wdLineStyleSingle
.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
.Borders(wdBorderTop).LineWidth = wdLineWidth050pt
.Borders(wdBorderBottom).LineWidth = wdLineWidth050pt
.Borders(wdBorderTop).Color = wdColorBlack
.Borders(wdBorderBottom).Color = wdColorBlack
End With 'end header row style

'Add (TBD) row - bottom right
Set myRange = objTable.Rows(.Rows.Count).Range
objTable.Rows(.Rows.Count).Select
Selection.InsertRowsBelow
Selection.Shading.Texture = wdTextureSolid
Selection.Shading.ForegroundPatternColor = wdColorWhite
Selection.Cells.Merge
Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
Selection.Borders.OutsideLineStyle = wdLineStyleNone
Selection.Style = ActiveDocument.Styles("Table Body")
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.TypeText Text:="(TBD)"

With .Rows(.Rows.Count - 1) 'last data row in the table
.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
.Borders(wdBorderBottom).LineWidth = wdLineWidth050pt
.Borders(wdBorderBottom).Color = wdColorBlack
.Borders.InsideLineStyle = wdLineStyleSingle
.Borders.InsideLineWidth = wdLineWidth050pt
.Borders.InsideColor = wdColorBlack
End With 'end last data row settings

End With
Next objTable

End Sub