Microsoft Office Forums - View Single Post - [Solved] Format Table(s) and Right-Align Cells with Dollars

JingleBelle · 04-21-2023, 07:52 AM

I often format very large documents that have many tables. It is not uncommon to have 50 or more tables. The tables are not uniform in design as far as content and number of columns and rows. Some tables contain all text (no numbers); others contain columns of text with columns of numbers.

To format tables, I use the following macro (originally coded by Guessed). I have a separate macro from Macropod that I was able to modify ever so slightly to do the right-align part. The problem in this instance is that it continues beyond the selection or selection of tables.

I would like to combine the macros into one that would apply the overall table formatting, then, go back and right-align cells that contain a dollar sign ($) followed by numbers.

I have worked for several days now to try to combine the two, but I have not been successful. I am hoping for some guidance from the experts. Thank you in advance for considering my problem/request.

Code:

Sub TableFormat()
'Author:    Guessed (a/k/a Andrew Lockton)
'Date:      Unknown

Dim objTable As Table
Dim MyRange As Range

Application.ScreenUpdating = False

    For Each objTable In Selection.Tables
      With objTable
         .Style = "Table Normal"        'clear any table style
         .RightPadding = 5              'measurement in points
         .LeftPadding = 5               'measurement in points
         .TopPadding = 0                'measurement in points
         .BottomPadding = 0             'measurement in points
         .Rows.SpaceBetweenColumns = CentimetersToPoints(0.2)
         .Rows.AllowBreakAcrossPages = False
         .Rows.Alignment = wdAlignRowCenter
         .Rows.HeightRule = wdRowHeightAuto
         .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
         .AutoFitBehavior (wdAutoFitContent)
         .PreferredWidthType = wdPreferredWidthPercent
         .PreferredWidth = 100
        
         With .Rows(1)
           .Range.Style = ActiveDocument.Styles("Table Heading")
           .Range.Rows.HeadingFormat = True
           .Cells.VerticalAlignment = wdAlignVerticalCenter
           .Shading.Texture = wdTextureNone
           .Shading.ForegroundPatternColor = wdColorAutomatic
           .Shading.BackgroundPatternColor = 10448684
        End With      'end the first row settings
      End With        'end table settings
    Next objTable     'move to the next table selected
Application.ScreenRefresh
Application.ScreenUpdating = True
End Sub

Sub AlignDollars()
' Author: Macropod (a/k/a Paul Edstein)
' Date:   February 2020

Dim oRange As Range
 
 Application.ScreenUpdating = False
    If Len(Selection.Range) = 0 Then
        MsgBox "Select the text first", vbCritical
        Exit Sub
    End If

    Set oRange = Selection.Range
'*What to look for
With Selection.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "$[0-9.,]{1,}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
'*Look only in tables
    If .Information(wdWithInTable) = True Then
'*Replacement Text
      .ParagraphFormat.Alignment = wdAlignParagraphRight
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub