Macro for adding zeroes to the front of numbers in specific Word doc table columns

[soulpow3r]

In a MS Word 97-02 doc table, I need to apply the following to the 1st column only:

I need to add zeroes (0s) to the front of numbers to bring them up to a total of 8 characters long. All of the numbers end with a letter or two, which are to be included in the 8 character count.

For example:

2020A (5 characters) must read 0002020A (8 characters)

123456AB (8 characters) remains unchanged

765432X (7 characters) must read 0765432X (8 characters)

How do I apply this to every field in the FIRST COLUMN ONLY of a table on a Word doc?

Here's the macro I'm working on...

[VBA]Sub FormatTables2PlusRows()
' Make the macro run fast by only displaying the end result
Application.ScreenUpdating = False
' Applies the properties defined to all documents in the document.
Selection.HomeKey Unit:=wdStory
'This declares the variable that counts the number of tables.
Dim iNumber As Integer
iNumber = ActiveDocument.Tables.Count
' This stops the macro running if there are no tables
If iNumber = 0 Then
MsgBox "There are no tables in this document"
End
Else
'This declares the variable that numbers the current table.
Dim iCurrent As Integer
For iCurrent = 1 To iNumber
' This finds the next table
Selection.GoTo What:=wdGoToTable, Which:=wdGoToNext, Count:=1, Name:=""
' This selects the table
With Selection
.SelectColumn
.SelectRow
End With
' This formats the table
With Selection.Tables(1)
' This removes the green shading
With .Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorAutomatic
End With
' This adds the borders
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With
With Selection.Borders(wdBorderTop)
.LineStyle = Options.DefaultBorderLineStyle
.LineWidth = Options.DefaultBorderLineWidth
.Color = Options.DefaultBorderColor
End With
With Selection.Borders(wdBorderLeft)
.LineStyle = Options.DefaultBorderLineStyle
.LineWidth = Options.DefaultBorderLineWidth
.Color = Options.DefaultBorderColor
End With
With Selection.Borders(wdBorderBottom)
.LineStyle = Options.DefaultBorderLineStyle
.LineWidth = Options.DefaultBorderLineWidth
.Color = Options.DefaultBorderColor
End With
With Selection.Borders(wdBorderRight)
.LineStyle = Options.DefaultBorderLineStyle
.LineWidth = Options.DefaultBorderLineWidth
.Color = Options.DefaultBorderColor
End With
With Selection.Borders(wdBorderHorizontal)
.LineStyle = Options.DefaultBorderLineStyle
.LineWidth = Options.DefaultBorderLineWidth
.Color = Options.DefaultBorderColor
End With
With Selection.Borders(wdBorderVertical)
.LineStyle = Options.DefaultBorderLineStyle
.LineWidth = Options.DefaultBorderLineWidth
.Color = Options.DefaultBorderColor
End With
' This removes the second column (provider's name)
Dim oTable As Table
For Each oTable In ActiveDocument.Tables
oTable.Columns(2).Delete
Next
' This removes all columns beyond the fourth row
Dim tbl As Table
For Each tbl In ActiveDocument.Tables
''First column is 1, not 0, ditto rows.
If tbl.Columns.Count > 4 Then
For i = tbl.Columns.Count To 5 Step -1
tbl.Columns(i).Delete
Next
End If
Next
' This centres and sets the table width to 98% of the page width
Selection.Tables(1).Rows.Alignment = wdAlignRowCenter
Selection.Tables(1).PreferredWidthType = wdPreferredWidthPercent
Selection.Tables(1).PreferredWidth = 98
' This sets the size and font within the table to Arial 11
Selection.WholeStory
Selection.Font.Size = 11
Selection.Font.Name = "Arial"
Selection.Collapse
' This loops to the next table until all the tables have been processed
Next iCurrent
End If
End Sub[/VBA]

Any suggestions will be greatly appreciated!

[Dave]

Maybe something like this? Dave
[VBA]
Dim Ocell as Variant
For Each tbl In ActiveDocument.Tables
''First column is 1, not 0, ditto rows.
If tbl.Columns.Count > 4 Then
For i = tbl.Columns.Count To 5 Step -1
tbl.Columns(i).Delete
Next
End If
For Each ocell In tbl.Range.Cells
Do While Len(ocell) < 9
ocell.Range = "0" & ocell.Range
Loop
Next ocell
Next tbl

[/VBA]

[soulpow3r]

Thanks Dave,

I've tried out your suggestion - I can see that you're on the right track, but it's not working how I'd like it to. It's adding 2 zeroes to the fourth column (which I don't want to touch) and it's not getting the number of zeroes right in the first column. When I have 3 or 4 characters, it's adding 2 zeros (bring the total number of characters up to 5 and 6 respectively) and it's adding only 1 zero to fields that have 5 or 6 characters (bringing them up to 6 and 7 characters respectively). For columns with 7 characters, it's not adding a zero at all.

I've tried modifying your code, but haven't had any luck yet.

Thanks again...

[soulpow3r]

I'm thinking

For Each ocell In tbl.Range.Cells

should be narrowing down each cell in the first column only. What do you think?

[Dave]

It's a bit more difficult than I thought. This works. Dave
[vba]
Dim temp as String
For Each Ocell In tbl.Columns(1).Cells
temp = Ocell.Range
Ocell.Range.Delete
temp = Left(temp, Len(temp) - 1)
Do While Len(temp) < 9
temp = "0" & temp
Loop
Ocell.Range = Left(temp, Len(temp) - 1)
Next Ocell
[/vba]

[soulpow3r]

Thanks Dave. I've tried it and I'm getting 'Run-time error '91' Object variable or With block variable not set'.

[macropod]

Try:
[VBA]Sub Demo()
Dim RngCel As Range, oCel As Cell, oTbl As Table
For Each oTbl In ActiveDocument.Tables
For Each oCel In oTbl.Columns(1).Cells
Set RngCel = oCel.Range
RngCel.End = RngCel.End - 1
While Len(RngCel.Text) < 8
RngCel.InsertBefore "0"
Wend
Next oCel
Next oTbl
End Sub[/VBA]

[soulpow3r]

Thanks Paul, that works beautifully.