Format Table(s) and Right-Align Cells with Dollars

JingleBelle · #1 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

gmayor · #2 04-21-2023, 09:23 PM

Maybe

Code:

Option Explicit

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

Dim objTable As Table
Dim MyRange As Range
Dim oCell As Cell

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
      For Each oCell In .Range.Cells
        Set MyRange = oCell.Range
        If InStr(1, MyRange.Text, "$") = 1 Then
            MyRange.ParagraphFormat.Alignment = wdAlignParagraphRight
        End If
      Next oCell
      End With        'end table settings
    
    Next objTable     'move to the next table selected
Application.ScreenRefresh
Application.ScreenUpdating = True
End Sub

JingleBelle · #3 04-22-2023, 07:00 AM

Of course, it works perfectly! Thank you, Graham, for taking the time to work this out for me. I truly appreciate it, and I hope it is useful to others who visit this forum. The experts, here, are a godsend. Thank you!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Align linked excel cells	p_c_a	Word	0	11-11-2022 05:14 AM
VBA to align left cells table	eduzs	Word VBA	2	06-25-2021 09:35 AM
How to set the table cells as time format?	jiaron_1230	Word VBA	3	11-15-2016 05:15 AM
How to format and align multiple tables in a document in bulk?	Joey Cheung	Word Tables	1	08-08-2014 11:34 PM
Unable to vertically center align texts in table cells?	tinfanide	Word	3	11-24-2013 06:37 AM