Solved: Comma format numbers in table columns

[mdmackillop]

I need to format certain columns with 4+ digits to a comma format in a number of tables. The code works for the first item in a table but then exits the loop. What am I missing?

[vba]Option Explicit

Sub TableGen()
Dim i As Long
Dim MyTable As Table
With ActiveDocument
For i = 1 To .Tables.Count
Set MyTable = .Tables(i)
Call CommaNumbering(MyTable, 4) 'Format column 4
Next
End With
End Sub


Sub CommaNumbering(MyTable As Table, i As Long)
'Method by Graham Mayor - Word MVP
Dim sText As String
Dim Rng As Range
Dim Fnd As Range

Set Rng = ActiveDocument.Range(Start:=MyTable.Cell(1, i).Range.Start, _
End:=MyTable.Cell(MyTable.Rows.Count, i).Range.End)
With Rng
With .Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(findText:="[0-9]{4,}", _
MatchWildcards:=True, Wrap:=wdFindStop, _
Forward:=True) = True
Set Fnd = .Parent
Fnd.Text = Format(Fnd.Text, "###,###,##0")
Loop
End With
End With
End Sub
[/vba]

[Tommy]

Hi MD,

I changed one thing and got all cells in the table LOL. You may need to itterate through each cell I don't think word handles tables like just the column it still goes left to right. Word processor mentallity
[VBA]
Do While .Execute(findText:="[0-9]{4,}", _
MatchWildcards:=True, Wrap:=wdFindContinue, _
Forward:=True) = True
Set Fnd = .Parent
Fnd.Text = Format(Fnd.Text, "###,###,##0")
Loop
[/VBA]

[mdmackillop]

Hi Tommy
I tried that, but it replaces in the entire table ie dates etc.. If I could determine the column of the found cell, the code could work by excluding the unwanted ones. I can't find a way to get this.

[Tommy]

So you are not necessacarily looking at one column you just want to change the number format in the table to the comma seperators right? Excluding dates and strings of course. Does you data contain a mixture?

You can extract all of the data into an array, but you have to put it back 1 at a time.

[Frosty]

You're discovering a fundamental difference between the way Word tables work vs. the way Excel spreadsheets work. As Tommy indicated... it goes left to right, and columns, in a funny kind of way, don't really exist in Word. Without going all theoretical on you... it relates to the fact that when you merge cells in Word you *really* merge them, as opposed to Excel where you can un-merge. In Word you would actually need to split the cell.

There are many many ways to break the table object, and you're just looking for a solution. Here it is


[vba]
Sub CommaNumbering(MyTable As Table, i As Long)
'Method by Graham Mayor - Word MVP
Dim sText As String
Dim Rng As Range
Dim Fnd As Range

Set Rng = ActiveDocument.Range(Start:=MyTable.Cell(1, i).Range.Start, _
End:=MyTable.Cell(MyTable.Rows.Count, i).Range.End)
With Rng
With .Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(findText:="[0-9]{4,}", _
MatchWildcards:=True, Wrap:=wdFindStop, _
Forward:=True) = True
Set Fnd = .Parent
Fnd.Text = Format(Fnd.Text, "###,###,##0")
're-define your range each time-- not the most efficient, but it works
Rng.Start = MyTable.Cell(1, i).Range.Start
Rng.End = MyTable.Cell(MyTable.Rows.Count, i).Range.End
Loop
End With
End With
End Sub
[/vba]

[mdmackillop]

Thanks Frosty,
That will do just fine. I had tried resetting the range in the loop but missed your method.
Regards
Malcolm

[Frosty]

Just to clarify, there are a lot of ways to address the above problem, and it may be safest not to rely on the concept of a column at all and iterate through each cell (as Tommy suggested).

But if you know the table(s) you're working with have never had any cells merged or split in it, the above code will work just fine.

Also, you don't really need the second range variable (Fnd), nor do you need to set it to the .Parent of the Rng variable. When you execute a .Find on a range object, it automatically redefines the range to the found (if it found anything)... so the following code would also work (I added a couple of lines to simplify the concept of what was actually going on, as well as taking out a reliance on ActiveDocument which is not a passed parameter and can technically cause something to break).
[vba]
Sub CommaNumbering(MyTable As Table, i As Long)
'Method by Graham Mayor - Word MVP
Dim Rng As Range

Set Rng = MyTable.Range
Rng.Start = MyTable.Cell(1, i).Range.Start
Rng.End = MyTable.Cell(MyTable.Rows.Count, i).Range.End

With Rng
With .Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(findText:="[0-9]{4,}", _
MatchWildcards:=True, Wrap:=wdFindStop, _
Forward:=True) = True
'format the find
Rng.Text = Format(Rng.Text, "###,###,##0")
'redefine the range
Rng.Start = MyTable.Cell(1, i).Range.Start
Rng.End = MyTable.Cell(MyTable.Rows.Count, i).Range.End
Loop
End With
End With
Set Rng = Nothing
End Sub
[/vba]
But since tables can get really wonky the table has *EVER* had any merged/split cells (even if it looks like it's a simple table, tables have a "history" element to them which will screw up code that relies on columns/rows properties)... so it's tough to rely on code like this if you don't know that the table is a simple one.

[Frosty]

Thanks Frosty,
That will do just fine. I had tried resetting the range in the loop but missed your method.
Regards
Malcolm

Ranges are funny little creatures... they don't necessarily like being "Set" within a With...End With statement, but they never seem to object to changing .Start and .End values.

[Tinbendr]

The same thing only different.

[VBA]Sub CommaNumbering(MyTable As Table, i As Long)
'Method by Graham Mayor - Word MVP
Dim sText As String
Dim Rng As Range
Dim Fnd As Range

Set Rng = MyTable.Range
With Rng
With .Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(findText:="[0-9]{4,}", _
MatchWildcards:=True, Wrap:=wdFindStop, _
Forward:=True) = True
Set Fnd = Rng.Duplicate
If Fnd.Cells(1).Column.Index = 4 Then
Fnd.Text = Format(Fnd.Text, "###,###,##0")
End If
Loop
End With
End With
End Sub[/VBA]

[Tommy]

But since tables can get really wonky the table has *EVER* had any merged/split cells (even if it looks like it's a simple table, tables have a "history" element to them which will screw up code that relies on columns/rows properties)... so it's tough to rely on code like this if you don't know that the table is a simple one.

Trying to work with one of these wonky tables will drive you to drink heavily. I have read somewhere, so take this with a grain of salt, that the only "reliable" method is to use the next and previous methods in the cells property. I have not used this and when I tried to look at it just to see.... my head started hurting, my eyes blurred, and that is when I decided I hated tables.

Good work Frosty!

[mdmackillop]

I'm copying data from Excel into Word and this is part of the tidying up process. I've made up some routines to set column widths and check for merged cells (which will be demerged).
Fortunately there is not a large amount of data in any report so speed of execution is not an issue, but consistency of result is.
Thanks for all contributions. I'll pick have a look at the options to find what suits best.

[Frosty]

If you are "demerging" the cells in Word, you're going to have issues. It would be better to de-merge them in Excel, and bring in a flat table.

Once you start splitting cells in Word, you're opening up a can of worms when you try to start referring to columns and rows in that table. Not talking about speed, but reliability can really only be counted on once you're down to the actual cell... columns and rows are simply not reliable in the word object model.

Just as background-- I spent half a year at one point documenting bugs in the Table object and working with MS programmers on various scenarios. In most cases we wound up at the point where they said "that's too deep into the core architecture, and it can't be fixed."

As a little tidbit... there are scenarios where selecting a word table with the mouse starting from the bottom right and moving to the top left (rather than top left to bottom right) will give you different results when referencing a table cell using Cells(x,y). And it always had to do with a table which had merged/resplit cells.

Obviously it depends on on the time you need to spend and the money involved... but I would definitely get your excel version of the "table" as simple as possible before bringing it into Word.

New tables are always fine. But tables with history... there be dragons in them hills.

[mdmackillop]

I found the demerging issues, thanks. This is my column check and width setting solution. I've not tried to automate demerging as too problematical and most issues should have been fixed in Excel before copying.
[vba]
Sub SortCells()
Dim arr, cel As Cell, r As Long, i As Long, c As Long
Dim Rw as Long

arr = Array(0, 1.37, 3.69, 4.87, 4.68, 5.28, 1.94, 2.16)
Selection.Tables(1).PreferredWidthType = wdPreferredWidthPoints
Selection.Tables(1).PreferredWidth = 680
Rw = Selection.Tables(1).Rows.Count
For r = 1 To Rw
If ActiveDocument.Tables(1).Rows(r).Cells.Count <> 7 Then
ActiveDocument.Tables(1).Cell(r, 1).Select
Exit Sub
End If
Next r
For r = 1 To Rw
For c = 1 To 7
ActiveDocument.Tables(1).Cell(r, c).PreferredWidth = CentimetersToPoints(arr(c))
Next c
Next r
End Sub

[/vba]

Final version of the number formatting code. Allowing for user input, I found David's code most amenable to my purpose.
Thanks to all.

[vba]
Sub TableGen()
Dim i As Long
Dim MyTable As Table
Dim Data As String

Data = InputBox("Columns to format; comma separated")

With ActiveDocument
For i = 1 To .Tables.Count
Set MyTable = .Tables(i)
Call CommaNumbering(MyTable, Data)
Next
End With
End Sub

Sub CommaNumbering(MyTable As Table, Cols as String)
'Method by Graham Mayor - Word MVP
Dim Rng As Range
Dim Fnd As Range
Dim arr, a
arr = Split(Cols, ",")
Set Rng = MyTable.Range
With Rng
With .Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(findText:="[0-9]{4,}", _
MatchWildcards:=True, Wrap:=wdFindStop, _
Forward:=True) = True
Set Fnd = Rng.Duplicate
For Each a In arr
If Fnd.Cells(1).Column.Index = a Then
Fnd.Text = Format(Fnd.Text, "###,###,##0")
End If
Next
Loop
End With
End With
End Sub
[/vba]

[macropod]

It seems to me you could probably get away with:
[VBA]Sub TableGen()
Application.ScreenUpdating = False
Dim oTbl As Table
With ActiveDocument
For Each oTbl In .Tables
With oTbl.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Wrap = wdFindStop
.Forward = True
.MatchWildcards = True
.Text = "([!\/][0-9])([0-9]{3}>)"
.Replacement.Text = "\1,\2"
.Execute Replace:=wdReplaceAll
.Text = "([0-9])([0-9]{3},)"
.Execute Replace:=wdReplaceAll
.Execute Replace:=wdReplaceAll
End With
Next
End With
Application.ScreenUpdating = True
End Sub[/VBA]
This code will leave dates alone, but will modify all other numbers in the tables without the need to specify the columns.

[macropod]

Re previous reply: I should have said dates in the d/m/y or m/d/y format - dates with spaces or hyphens would still be affected (though expanding the [!\/] to [!\/\-] would take care of the hyphens).

[mdmackillop]

Thanks for that Paul.
My tables may contain References, Dates, Dimensions and Costs. Usually these will be in specific columns hence the need for column formatting rather than a general application in my particular case.

[Frosty]

mdmac... you should probably check out the whole mvps.org word article on using wildcard searches and "flushing bad karma" and add that to the code.

I'm a fan of Paul's structure, incidentally, even if you didn't use a replace all... it's a lot easier to troubleshoot/modify if you have it like this
[vba]
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[0-9]{4,}"
.MatchWildcards = True
.Wrap = wdFindStop
.Forward = True
Do While .Execute = True
Set Fnd = Rng.Duplicate
For Each a In arr
If Fnd.Cells(1).Column.Index = a Then
Fnd.Text = Format(Fnd.Text, "###,###,##0")
End If
Next
Loop
End With[/vba]

Just a spitball...

[macropod]

The way I'd approach the task for specified columns is:
[VBA]Sub TableGen()
Application.ScreenUpdating = False
Dim oTbl As Table, fRng As Range, Data, iCol
Data = Split(InputBox("Columns to format; comma separated"), ",")
With ActiveDocument
For Each oTbl In .Tables
For Each iCol In Data
With oTbl
Set fRng = .Cell(1, iCol).Range
fRng.End = .Cell(.Rows.Count, iCol).Range.End
End With
With fRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Wrap = wdFindStop
.Forward = True
.MatchWildcards = True
.Text = "([!\/-][0-9])([0-9]{3}>)"
.Replacement.Text = "\1,\2"
.Execute Replace:=wdReplaceAll
.Text = "([0-9])([0-9]{3},)"
.Execute Replace:=wdReplaceAll
.Execute Replace:=wdReplaceAll
End With
Next iCol
Next oTbl
End With
Application.ScreenUpdating = True
End Sub[/VBA]