Apply Formatting to Tables According to Content

I have a document that is ~1200 pages and contains hundreds of tables. There are two types of tables. I already have code that will apply standardized formatting to all tables; however, in this instance, I need to apply different formatting to each table type. For one table type, I need shading on the first row. For the second table type, I need the shading in the first column. The tables have varying numbers of columns and rows.

I have managed to cobble together code that will search for the specific text that is in each table type and format the table accordingly. As it is now, it searches for text anywhere in the table. It would be more reliable if it would search the first row of each table for the specific text. That is where I am stuck. I have limited experience with VBA, and I do not know which commands would do that or how the commands fit into my current code. In addition, I have it as two subs—one that calls on the other. I do not know if that is good, bad, or somewhere in between.

Would you look at my code and tell me what I need to change to get it to search in the first row? Thank you for considering my request.

Sub Table1_Format()



DimobjTable As Table

DimobjCell As Cell

DimobjRange As Range


Application.ScreenUpdating= False
ForEach objTable In ActiveDocument.Tables

For Each objCell In objTable.Range.Cells

Set objRange = objCell.Range
objRange.End = objRange.End - 1

Dim cellvalue As String

'Enter textinside quotation marks
If InStr(objRange, "ABCD")Then


objTable.Range.Font.Name ="Arial"
objTable.Range.Font.Size = 8
objTable.Range.Font.ColorIndex =wdAuto
objTable.Rows.AllowBreakAcrossPages =False
objTable.Rows.Alignment =wdAlignRowCenter
objTable.Rows.HeightRule =wdRowHeightAuto
objTable.Rows.Borders.InsideLineStyle= wdLineStyleSingle
objTable.Rows.Borders.InsideLineWidth= wdLineWidth050pt
objTable.Rows.Borders.OutsideLineStyle = wdLineStyleSingle
objTable.Rows.Borders.OutsideLineWidth= wdLineWidth150pt
objTable.Rows.Borders.InsideColor =wdColorBlack

objTable.AutoFitBehavior(wdAutoFitContent)
objTable.PreferredWidthType =wdPreferredWidthPercent
objTable.PreferredWidth = 100

objTable.Columns(1).Shading.BackgroundPatternColor = wdColorGray10
objTable.Columns(1).Select
Selection.Font.Bold = True




End If
Next
Next

CallTable2_Format

EndSub



Sub Table2_Format()

DimobjTable As Table
DimobjCell As Cell
DimobjRange As Range

ForEach objTable In ActiveDocument.Tables

For Each objCell In objTable.Range.Cells

Set objRange = objCell.Range
objRange.End = objRange.End - 1

Dim cellvalue As String

'Enter textinside quotation marks
If InStr(objRange, "WXYZ:")Then


objTable.Range.Font.Name ="Arial"
objTable.Range.Font.Size = 8
objTable.Range.Font.ColorIndex =wdAuto
objTable.Rows.AllowBreakAcrossPages =False
objTable.Rows.Alignment =wdAlignRowCenter
objTable.Rows.HeightRule =wdRowHeightAuto
objTable.Rows.Borders.InsideLineStyle= wdLineStyleSingle
objTable.Rows.Borders.InsideLineWidth= wdLineWidth050pt
objTable.Rows.Borders.OutsideLineStyle = wdLineStyleSingle
objTable.Rows.Borders.OutsideLineWidth = wdLineWidth150pt
objTable.Rows.Borders.InsideColor =wdColorBlack

objTable.AutoFitBehavior(wdAutoFitContent)
objTable.PreferredWidthType =wdPreferredWidthPercent
objTable.PreferredWidth = 100

objTable.Rows(1).Shading.BackgroundPatternColor = wdColorDarkBlue
objTable.Rows(1).Range.Font.Bold =True
objTable.Rows(1).Range.ParagraphFormat.Alignment =wdAlignParagraphCenter
objTable.Rows(1).Cells.VerticalAlignment = wdCellAlignVerticalCenter

End If

Next

Next

Application.ScreenUpdating = True
Application.ScreenRefresh
Selection.HomeKey Unit:=wdStory
MsgBox "Done!", vbInformation

EndSub

You can use the same range to search for both texts, assuming both are in row 1, which cuts the processing down by half e.g. as follows. This will work provided there are no merged cells.

Code:

---

Sub Table_Format()Dim objTable As Table
Dim objCell As Cell
Dim objRange As Range
Dim cellvalue As String
    'Enter texts inside quotation marks
Const strFind1 As String = "ABCD"
Const strFind2 As String = "WXYZ:"


    Application.ScreenUpdating = False
    For Each objTable In ActiveDocument.Tables
        For Each objCell In objTable.Range.Rows(1).Cells
            Set objRange = objCell.Range
            objRange.End = objRange.End - 1
            If InStr(objRange, strFind1) Then
                objTable.Range.Font.Name = "Arial"
                objTable.Range.Font.Size = 8
                objTable.Range.Font.ColorIndex = wdAuto
                objTable.Rows.AllowBreakAcrossPages = False
                objTable.Rows.Alignment = wdAlignRowCenter
                objTable.Rows.HeightRule = wdRowHeightAuto
                objTable.Rows.Borders.InsideLineStyle = wdLineStyleSingle
                objTable.Rows.Borders.InsideLineWidth = wdLineWidth050pt
                objTable.Rows.Borders.OutsideLineStyle = wdLineStyleSingle
                objTable.Rows.Borders.OutsideLineWidth = wdLineWidth150pt
                objTable.Rows.Borders.InsideColor = wdColorBlack


                objTable.AutoFitBehavior (wdAutoFitContent)
                objTable.PreferredWidthType = wdPreferredWidthPercent
                objTable.PreferredWidth = 100


                objTable.Columns(1).Shading.BackgroundPatternColor = wdColorGray10
                objTable.Columns(1).Select
                Selection.Font.Bold = True
                Exit For
            End If
            If InStr(objRange, strFind2) Then
                objTable.Range.Font.Name = "Arial"
                objTable.Range.Font.Size = 8
                objTable.Range.Font.ColorIndex = wdAuto
                objTable.Rows.AllowBreakAcrossPages = False
                objTable.Rows.Alignment = wdAlignRowCenter
                objTable.Rows.HeightRule = wdRowHeightAuto
                objTable.Rows.Borders.InsideLineStyle = wdLineStyleSingle
                objTable.Rows.Borders.InsideLineWidth = wdLineWidth050pt
                objTable.Rows.Borders.OutsideLineStyle = wdLineStyleSingle
                objTable.Rows.Borders.OutsideLineWidth = wdLineWidth150pt
                objTable.Rows.Borders.InsideColor = wdColorBlack


                objTable.AutoFitBehavior (wdAutoFitContent)
                objTable.PreferredWidthType = wdPreferredWidthPercent
                objTable.PreferredWidth = 100


                objTable.Rows(1).Shading.BackgroundPatternColor = wdColorDarkBlue
                objTable.Rows(1).Range.Font.Bold = True
                objTable.Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                objTable.Rows(1).Cells.VerticalAlignment = wdCellAlignVerticalCenter
                Exit For
            End If
        Next
    Next
    Application.ScreenUpdating = True
    Application.ScreenRefresh
    Selection.HomeKey Unit:=wdStory
    MsgBox "Done!", vbInformation
End Sub

---

Mr. Mayor,
It works like a charm (and faster)! It is perfect. Thank you, thank you, thank you!