Solved: Loop through cells in a column (Word table)

[TrippyTom]

Hi peeps,

I have a table with numbers in column 2 and 3. I have already set 2 tabs through code (left tab at 0.08", decimal tab at 0.85"). The column width is also set at 0.97" wide.

I need to insert two Tabs (vbtab) in front of the numbers so they will line up with the tabs I already set.

If it's empty just skip the cell.

Is there an easy way to do this?

[macropod]

Hi TrippyTom,

You wouldn't need any tabs at all if you deleted the left tab-stop. What purpose does it serve?

[TrippyTom]

Unfortunately, I need that tab in there because the formatting requirements are extremely particular.

Some of the cells need a single underline, but they didn't want a bottom border on the entire cell. Instead, they wanted an underline from AFTER the 1st tab to the end of the number (excluding the right parenthesis if it's negative so it looks like it's hanging over the "edge").

Yes, crazy I know, but that's why I need the tabs how I've set them. Here's an example of how one of the numbers will look:

Incidently, the first tab stop changes based on the longest number in the column (I think I will have to move that manually as I can't think of a macro being able to figure that out).

[macropod]

OK TrippyTom,

Here's a macro to process all tables in the document:

Sub AddTabs()
Dim oTbl As Table
Dim oRow As Row
Dim oRng As Range
For Each oTbl In ActiveDocument.Tables
For Each oRow In oTbl.Rows
Set oRng = oRow.Cells(2).Range
oRng.End = oRng.End - 1
If Trim(oRng.Text) <> "" Then oRng.Text = vbTab & vbTab & Replace(oRng.Text, vbTab, "")
Set oRng = oRow.Cells(3).Range
oRng.End = oRng.End - 1
If Trim(oRng.Text) <> "" Then oRng.Text = vbTab & vbTab & Replace(oRng.Text, vbTab, "")
Next
Next
End Sub

Cheers

[TrippyTom]

Thanks a bunch. :) This will help a lot.

[TrippyTom]

Could you explain how the REPLACE functionality works? I need to do something similar to this on another part of my table but can't quite figure out the syntax.

I have a 4th column with "%" in some cells. I figured I could use something similar to append that % sign to the end of the number in column 3, based on your code above, but I can't get the syntax right.

Here's my stab at it. :) (don't laugh, I'm still learning here)
Sub fixPercent()
' assume you've already cleared rows/cols, stripped spaces
' and % is in the 4th column now
Dim oTbl As Table
Dim oRow As Row
Dim oRng As Range

Set oTbl = Selection.Tables(1)
For Each oRow In oTbl.Rows

Set oRng = oRow.Cells(4).Range
oRng.End = oRng.End - 1
If Trim(oRng.Text) <> "" And _
Trim(oRng.Text) = "%" Then _
oRow.Cells(3).Range.Text = Replace(oRow.Cells(3).Range.Text, _
oRow.Cells(3).Range.Text, oRow.Cells(3).Range.Text) & "%"
Next
End Sub

It's adding it to the end, but there's a Paragraph mark between the number and the % sign. I'm sure it's just a matter of fixing my syntax, but I'm not sure where I went wrong.

[TrippyTom]

I changed it to this, and it worked, but I would still like you to explain how REPLACE works. I'm not entirely sure how I got it to work. :)
Sub fixPercent()
' assume you've already cleared rows/cols, stripped spaces
' and % is in the 4th column now
Dim oTbl As Table
Dim oRow As Row
Dim oRng As Range

Set oTbl = Selection.Tables(1)
For Each oRow In oTbl.Rows

Set oRng = oRow.Cells(4).Range
oRng.End = oRng.End - 1
If Trim(oRng.Text) <> "" And _
Trim(oRng.Text) = "%" Then _
oRow.Cells(3).Range.Text = Replace(oRow.Cells(3).Range.Text, vbCr, "%")
Next
End Sub

[fumei]

If you have IntelliSense ON, in a code module you can type:

replace(

and as soon as you type the bracket, you will see a pop-up with:

Replace(Expression as String, Find as String,
Replace as String, [Start as Long = 1], [Count as Long = -1],
[Compare As vbCompareMethod = vbBinaryCompare])[i] As String

So.....

Replace ("this is some text", "some", "yadda")

will return:

"this is yadda text"

The "this is some text" can be - as in the case above - a string literal (an actual string), OR a string variable, such as:


Dim strIn As String
strIn = "this is some text"
Msgbox Replace (strIn, "some", "yadda")
This would display a messagebox with "this is yadda text"

Replace returns a string that replaces a given string (the Find parameter) with a replacement string (the Replace parameter) in any string passed to the function (the Expression parameter).

The Expression is strIn (set as "this is some text")
The Find is "some"
The Replace is "yadda"

NOTE: the default replaces all found instances of Find.

E.g. Replace("this is some text, this is some text, this is some text", "some", "yadda")

returns: "this is yadda text, this is yadda text, this is yadda text"

You can both set the starting position (the Start parameter, default = 1...the beginning of the expression), and/or the Count.

Replace("this is some text, this is some text, this is some text", "some", "yadda", 1, 2)

has Start = 1, and Count = 2, so....it returns:

"this is yadda text, this is yadda text, this is some text"

"some" (the Find) is replaced twice (the Count parameter), starting from position 1 (the Start parameter).

Be careful though. Using the Start parameter means that any text BEFORE the Start value is NOT returned. Start is not really the start position of the Find action, but the start position of the returned string.

Replace("this is some text, this is some text, this is some text", "some", "yadda", 13, 2)

returns: "text, this is yadda text, this is yadda text"

The returned string Starts at the 13th character, and replaces "some" with "yadda" for a count of 2.

[TrippyTom]

Thanks very much for that explanation, Fumei. :) I was looking through help in the VBA object window, but I had it filtered to Word only commands, so I didn't find it. Apparently Replace is a general VBA function not specific to Word only.

So if I apply what you said to my code above, the reason it works is it's basically taking the contents of the cell to the left, dumping that into the expression part, and replacing an invisible carriage return with the % sign?

[fumei]

Careful. Using Range.Text for table cells can be tricky. It is not an "invisible carriage return" - although it can be useful to think of it that way - it actually is a end-of-cell marker...though in reality a paragraph mark...and so....a carriage return.

You can NOT, repeat NOT, get rid of the end-of-cell marker in a Word table cell. Table cells will always have an end-of-cell marker. Your code is quite straightforward:
oRow.Cells(3).Range.Text = _
Replace(oRow.Cells(3).Range.Text, vbCr, "%")
replaces all vbCr in Cells(3) with "%"

As to your question regarding the reason it works...yes.

[macropod]

Hi TrippyTom,

I trust you're happy with Gerry's explanation.

FWIW, the only reason I used the vba Replace function was to strip off any tabs that might already have been present in the cells being processed. That way, running the macro multiple times wouldn't keep adding tabs to the tabs that were already there.

Your 'FixPercent' code could probably be reduced to:

Sub FixPercent()
Dim oTbl As Table
Dim oRow As Row
Dim oRng As Range
For Each oTbl In ActiveDocument.Tables
For Each oRow In oTbl.Rows
Set oRng = oRow.Cells(4).Range
oRng.End = oRng.End - 1
If Trim(oRng.Text) <> "" And Right(oRng.Text, 1) <> "%" Then oRng.Text = oRng.Text & "%"
Next
Next
End Sub
Note that even the logic in this sub could be rolled into the previous macro I posted

[TrippyTom]

Yes, thank you both for your help.

I only have one more part left to this project and that's doing the underline based on their specific needs. I will probably use a combination of LEN and RIGHT functions to make it work.

Based on both your help I think I'll be able to figure it out, but I'll post back if I run into another snag.

Thanks again. This was a good learning experience for me. Both of you have explained things very well in the past, and I appreciate it.

[fumei]

Hi. You mention: "and that's doing the underline based on their specific needs. "

1. how are you determining that? How are you finding out what those needs are?

2. Are these needs actioned sequentially?

I need THIS.....do it.
I need THAT.....do it
I need ThatThat.....do it

Or are they "gathered", THEN actioned?

I need THIS
I need THAT
I need ThatThat

Do This
Do That
Do ThatThat

2. based on those needs, it would be better to apply a Character style, rather than any manually formatting.

So taking Tony's code:

Sub FixPercent()
Dim oTbl As Table
Dim oRow As Row
Dim oRng As Range
For Each oTbl In ActiveDocument.Tables
For Each oRow In oTbl.Rows
Set oRng = oRow.Cells(4).Range
oRng.End = oRng.End - 1
If Trim(oRng.Text) <> "" And _
Right(oRng.Text, 1) <> "%" Then _
With oRng
.Text = oRng.Text & "%"
.Style = "myUnderline"
End With
Next
Next
End Sub
applies a character style (myUnderline) as part of the logic. You of course have to have such a style...but you should anyway.

[TrippyTom]

Hmm... good questions. I'm unclear why I would need a character style though.

I explained the underlining specifications in post #3. The underline length varies if it's negative (don't underline the right parenthesis), but it always starts from AFTER the first tab. With my limited knowledge in Word coding, I couldn't think of a better way than manual formatting. A character style can't be that flexible, can it?

This is how I worked out the underlining:
preface) I have about 20 files I'm doing this on - each one has a similar range that I copy/paste from Excel into Word
- I already have other macros to strip out any blank rows or columns, which leaves me with 3 columns total
- then I have another macro that removes ALL spaces in columns 2 and 3
- Then I add the 2 tabs to columns 2 and 3
- Then I run the code below to replace any bottom border with a real underline based on my specific needs.

It's only for Column 2. Column 3 will be slightly different so I figured I would put it in a separate subroutine.
Sub SingleLineCOL2()
Dim cel As Cell
Dim rng As Range
Dim myCol As Column

Set myCol = Selection.Tables(1).Columns(2)
For Each cel In myCol.Cells
Set rng = cel.Range
rng.MoveEnd Unit:=wdCharacter, Count:=-1
rng.Select

'CHECK FOR BORDER FIRST
If cel.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle Then

'CHECK FOR NEGATIVE
If Right(rng.Text, 1) = ")" Then
With Selection
Selection.HomeKey Unit:=wdLine
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtend
Selection.Font.Underline = wdUnderlineSingle
End With
cel.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
Else
With Selection
Selection.HomeKey Unit:=wdLine
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Font.Underline = wdUnderlineSingle
End With
cel.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
End If
End If
Next cel
End Sub

[fumei]

The problem is you are using Selection so much. Frankly, I would not use Selection at all.

But, even if you do, yes Character styles are that flexible. They are simply...character styles.

If a character style is defined as being underlined, then any characters that have the style applied to will be underlined.

It is really that simple.

I do not see the need for:

- Then I add the 2 tabs to columns 2 and 3

Why? Again, with explicit and proper use of styles, there is no need for any manual formatting, including adding tabs. Simply have logic that says:

If [i]condition[/b] Then cell.range style = X

The style X can be a Paragraph style that is indented and underlined. If you need only part of the cell text to be underlined (but still indented, not tabbed):

If [i]condition[/b] Then
cell.range style = X ' the Paragraph style, indented
' get and set a range for the part to be underlined
range.style = U
End If

What, precisely is the logic?

[TrippyTom]

Hi again Fumei,

I originally had a very long post in reply to yours, but after re-reading your post several times... I think I was missing something that's obvious to you. I think I finally understand what you were saying.

The main problem is I don't have a very good grasp on ranges in Word. I will try out your idea and get back to you. Thanks for being so patient with me. :)

[TrippyTom]

sorry, one more question:

The reason I set them as tabs is because the first tab varies based on the longest number in column 2. I move it manually if it needs to be adjusted (I make it line up with the $ in the longest number). Which, in turn, adjusts the width of the underlines as well.

If code can determine the length of the longest number (and thus, the tab stop) that would be fantastic. Unfortunately, I'm using Arial 8pt font, which is not equally spaced per letter. So I didn't think code would be able to figure that out.

But if it can, I should be able to set my character style through code to adjust the indent based on the longest number, right?

[macropod]

Hi TrippyTom,

Unfortunately, I'm using Arial 8pt font, which is not equally spaced per letter.
Actually, the numbers in all fonts supplied with Windows, and most (if not all) commercial fonts do have the same character width.

In any event, you don't really need to know anything about that. All you need to know is the position of the first character in the cell containing the most characters. You can do this with:
Selection.Information(wdHorizontalPositionRelativeToTextBoundary)
or, better still, the corresponding Range attribute.

[TrippyTom]

oh wow, I didn't know you could do that.

So I could loop thru the cells in the column, find the longest number by using LEN(), and run that command on it to find where my tabs should be on the paragraph style that Fumei mentioned?

[macropod]

Hi TrippyTom,

Yes, like this (for example):

Sub Demo()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim TabRng As Range
Dim TabPos As Single
With ActiveDocument.Tables(1)
For i = 1 To .Rows.Count
If Len(.Range.Text) > j Then
j = Len(.Range.Text)
k = i
End If
Next
Set TabRng = .Cell(k, 2).Range.Characters(1)
TabRng.MoveEnd wdCharacter, -1
TabPos = TabRng.Information(wdHorizontalPositionRelativeToTextBoundary)
For i = 1 To .Rows.Count
.Cell(i, 2).Range.Paragraphs(1).TabStops.Add TabPos, wdAlignTabLeft
Next
End With
End Sub

[fumei]

I am really not following what it is you actually need.

"tab stop changes based on the longest number in the column "

From looking at the image you supplied in post #3, ummm, why not simply make it right aligned?

I still do not see why you are messing around with tabs.

[TrippyTom]

Hi Macropod,

Your sample code is taking the position from the first row instead of the row with the longest number. I tested this with a number like "$34" in row 1 and the tabstop lines up with that position instead of the one with the longest number.

I've tried going through the code to see if I can tweak it but it's a bit beyond me. Is it an easy fix?

Thanks again guys, this is a good learning experience for me. I rarely code in Word.

[TrippyTom]

Fumei, I'm not ignoring you. I'm just trying to word it in as clear a manner as I possibly can so I don't make you more frustrated. :)

It might take me a while. I think a better (new) screenshot will help.

[macropod]

Hi TrippyTom,

Oops! Instead of:

If Len(.Range.Text) > j Then
j = Len(.Range.Text)
I should have used:

If Len(.Cell(i, 2).Range.Text) > j Then
j = Len(.Cell(i, 2).Range.Text)
Note that the macro this is from is only coded to process column 2 in the 1st table. I'll leave it to you to add the necessary code to process multiple tables & columns - the code you've already got gives enough hints on that.

[TrippyTom]

I almost hate to ask this, but...

How easy would it be to get the right most location as well so I can set the decimal tab too? I'm centering Column 2 first, then running this code that I tried, based on yours...
With .Columns(2).Cells(k)
.Select
Selection.HomeKey Unit:=wdLine
LeftPos = Selection.Information(wdHorizontalPositionRelativeToTextBoundary)
Selection.EndKey Unit:=wdLine
RightPos = Selection.Information(wdHorizontalPositionRelativeToTextBoundary)
End With


and tried using those variables here:
For i = 1 To .Rows.Count
If i = .Rows.Count Then 'last row
.Cell(i, 2).Range.Paragraphs(1).TabStops.Add LeftPos, wdAlignTabLeft
.Cell(i, 2).Range.Paragraphs(1).TabStops.Add RightPos, wdAlignTabRight
Else
.Cell(i, 2).Range.Paragraphs(1).TabStops.Add LeftPos, wdAlignTabLeft
.Cell(i, 2).Range.Paragraphs(1).TabStops.Add RightPos, wdAlignTabDecimal
End If
Next

But it's shifting both tabs to the right too far. This whole range thing is really difficult to understand for me.

[TrippyTom]

Wow, I think I figured it out. Is this how you would have done it?
With ActiveDocument.Tables(1)
For i = 1 To .Rows.Count
If Len(.Cell(i, 2).Range.Text) > j Then
j = Len(.Cell(i, 2).Range.Text)
k = i
End If
Next
Set TabRng = .Cell(k, 2).Range.Characters(1)
TabRng.MoveEnd wdCharacter, -1
LeftPos = TabRng.Information(wdHorizontalPositionRelativeToTextBoundary)

myCharLength = .Cell(k, 2).Range.Characters.Count
Set TabRightRng = .Cell(k, 2).Range.Characters(myCharLength)
TabRightRng.MoveEnd wdCharacter, -1
RightPos = TabRightRng.Information(wdHorizontalPositionRelativeToTextBoundary)

For i = 1 To .Rows.Count
.Cell(i, 2).Range.Paragraphs(1).TabStops.Add LeftPos, wdAlignTabLeft
.Cell(i, 2).Range.Paragraphs(1).TabStops.Add RightPos, wdAlignTabDecimal
Next
End With

[macropod]

Hi TrippyTom,

If I were doing this, I think I'd be adding the decimal tabstops *before* tring to do anything with the left tabstops. As for the left tabs and tabstops , I suspect you probably only need one of each per column - for the row on which the underlining is to be applied.

Also, you probably should have your code delete any existing left tabstops in the columns concerned before calculating & adding the new one(s). Otherwise, there's the prospect of having too many tabstops if you need to re-run the code. Similarly, you could test for the presence of any decimal tabstops so that you don't add them unnecessarily - or, perhaps you could delete them (as per the left tabstops) if there's the prospect of having to add new ones at a different position.