Bold Text Highest value cells in each column of several tables

[The Bodkin]

Hi first time poster and very green with VBA

I have a word document with several numerical tables and I am wanting to highlight the highest value in each column of each table by making the font bold.

Is it possible to do this with a macro?

[macropod]

For example:

Sub TblBldNum()
Application.ScreenUpdating = False
Dim Tbl As Table, r As Long, c As Long, x As Long, v As Single, StrTxt As String
For Each Tbl In ActiveDocument.Tables
With Tbl
For c = 1 To .Columns.Count
v = 0: x = 0
For r = 1 To .Rows.Count
StrTxt = Split(.Cell(r, c).Range.Text, vbCr)(0)
If IsNumeric(StrTxt) Then
If CSng(StrTxt) > v Then
v = CSng(StrTxt): x = r
End If
End If
Next
If x > 0 Then .Cell(x, c).Range.Font.Bold = True
Next
End With
Next
Application.ScreenUpdating = True
End Sub
Note: If two or more cells in the column have the same maximum value, only the first will be bolded. To bold all cells matching the maximum value, replace:

If x > 0 Then .Cell(x, c).Range.Font.Bold = True
with:

If x > 0 Then
.Cell(x, c).Range.Font.Bold = True
StrTxt = Split(.Cell(x, c).Range.Text, vbCr)(0)
For r = x + 1 To .Rows.Count
With .Cell(r, c).Range
If Split(.Text, vbCr)(0) = StrTxt Then .Font.Bold = True
End With
Next
End If

[The Bodkin]

Thank you Macropod you are a superstar