Table Column Macro Loop

[bigjaker]

I am in need of a macro that will go from table to table in a file until it reaches the end of the file making changes. I will include what I have so far. I need to find some text that is specific to this table and then in that same column (column 4) need to have all the numbers change from 5 digits to the right of the decimal to 3 digits (ex. 3.25102 to 3.251). Basically deleting the right 2 numbers no matter what they are. Once it scrolls through that table column it needs to find the next table in the document with the same word in the header and repeat the process. Each of these tables are 5 columns wide, with a header row, there are no merged cells, but the tables might be 2 rows (including the heading row) or much longer.


Sub Macro4()
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Test1"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Dim oCell As Cell
'Select the fourth cell in the first row of the table
Selection.Tables(1).Cell(1, 4).Select
'Select column 4
Selection.SelectColumn
'Operate on the cells in column 4
For Each oCell In Selection.Cells
Selection.Find.ClearFormatting
With Selection.Find
.Text = "."
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=4
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Next oCell
Application.GoBack
End Sub

I have tried to set up a loop and can't get it to work either.

Any help would be much appreciated. - Jake

[TonyJollans]

I think this is one of those cases where you must use the Selection. Try this:

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
For Each t In ActiveDocument.Tables
Set r = t.Range.Duplicate
If r.Find.Execute(findtext:="Test1") Then
If r.Columns(1).Index = 4 Then
r.Columns(1).Select
Selection.Find.Execute findtext:="(<[0-9]{1,}.[0-9]{3})[0-9]{2}>", _
replacewith:="\1", _
Replace:=wdReplaceAll, _
Wrap:=wdFindStop, _
MatchWildcards:=True
End If
End If
Next


There's probably a silly mistake in there but it should get you started.

[bigjaker]

Tony thank you very much that works perfectly.

I have another question though. What would I have to change to make it change the decimal to 2 places or 4 places. I would like to learn more about how it works. I have already figured out how to change from one column to another by changing the number and column heading.

"I will take all the fish that I can get, but I would like some time in the boat as well"

-Jake

[TonyJollans]

The FindText pattern (ignoring the parentheses for a moment) is: <[0-9]{1,}.[0-9]{3}[0-9]{2}>

This breaks down as:
< means start of a 'word' (space- or punctuation-delimited string)
[0-9]{1,} means any of the characters 0-9, from 1 to an unspecified many ocuurrences
. means . (the decimal point)
[0-9]{3} means any of the characters 0-9, exactly three times
[0-9]{2} means any of the characters 0-9, exactly two times
> means the end of a word (this stops it finding numbers with 6 or more decimals)

The parentheses are simply used to group part of what is found so that it can be referred to in the replace string. \1 means the first parenthesised expression (in this case all but the last two decimals)

[bigjaker]

Thank you Tony for explaining. I really appreciate it.

Jake