add border to table cell and merge with other cells

[stuck]

There's something wrong with my loops, what I want is:

For rows 2 & 3
    start in cell 3
    For 1 to x (x is a known variable)
        add a bottom border to the cell
        now merge this cell with the next n cells (n is a known variable)
        increment variables to move to the next cell to be bordered and merged
    next x
next row

I'll give my (rubbish) code in a minute but first I'll step though what is happening:
1) on entering the For rows 2 & 3 loop the insertion point is put into the correct cell and the hole cell is selected
2) on entering the For 1 to x loop the cell is merged with the correct number of cells to the right and the bottom border goes across just the merged cells
3) on looping to the next x the insertion point moves correctly to the next cell BUT instead of the border being applied to just the selected cell, all cells from the start of the row up to and including the selected cell are bordered.
4) HOWEVER! on looping to row 3 the code steps across the columns bordering and merging cells as I wish.

I can't see why the borders are failing first time through the outer loop but it all works as expected the second time through.

Ken

Code: Select all

           .
           .
           somewhere before the loops the variable 'offset' gets a value, say = 1
           .
           .
            For hdrRow = 2 To 3

                Set rng = Selection.Tables(1).Cell(hdrRow, 3).Range
                rng.Collapse Direction:=wdCollapseStart
                rng.Select

                startingColNum = 3
                
                For analyteNo = 1 To num

                    Selection.Tables(1).Cell(hdrRow, startingColNum).Select

                    With Selection
                        With .Borders(wdBorderBottom)
                            .LineStyle = wdLineStyleSingle
                            .LineWidth = wdLineWidth075pt
                            .Color = wdColorBlack
                        End With
                    End With

                    With Selection.Tables(1)
                        Set rng = .Cell(hdrRow, startingColNum).Range
                        rng.End = .Cell(hdrRow, startingColNum + offset).Range.End
                        rng.Cells.Merge
                    End With

                    startingColNum =  startingColNum + 2

                Next analyteNo

            Next hdrRow

[HansV]

I cannot reproduce the error. Have your tested your code on more than one table?

[stuck]

Have your tested your code on more than one table?

Yes, same effect. First time through I end up with a border that goes from row 2 cell 1 to the end but second time through to do row 3 I get the correct effect, only the merged cells are bordered and the cells in cols 1 & 2 and in between the merged cells are unbordered.

OK, thanks for looking.

Ken

[HansV]

This is what I get in Word 2010 with Num=3 and Offset=1:

S283.png

[stuck]

What happens if your starting table looks like the attached?

[stuck]

Also, if I step backwards through the outer loop, i.e. border & merge row 3 before row 2 then the problem transfers to row 3, i.e it's the first time through the loop that's going wrong.



Ken

[HansV]

As a workaround, you could remove the top row temporarily and restore it at the end:

Code: Select all

Sub Test()
    Dim hdrRow As Long
    Dim rng As Range
    Dim startingColNum As Long
    Dim analyteNo As Long
    Dim Num As Long
    Dim Offset As Long

    Offset = 1
    Num = 4
    ' Cut the top row
    Selection.Tables(1).Rows(1).Range.Cut

    ' Row numbers decreased by 1
    For hdrRow = 1 To 2

        Set rng = Selection.Tables(1).Cell(hdrRow, 3).Range
        rng.Collapse Direction:=wdCollapseStart
        rng.Select

        startingColNum = 3
        
        For analyteNo = 1 To Num

            Selection.Tables(1).Cell(hdrRow, startingColNum).Select

            With Selection
                With .Borders(wdBorderBottom)
                    .LineStyle = wdLineStyleSingle
                    .LineWidth = wdLineWidth075pt
                    .Color = wdColorBlack
                End With
            End With

            With Selection.Tables(1)
                Set rng = .Cell(hdrRow, startingColNum).Range
                rng.End = .Cell(hdrRow, startingColNum + Offset).Range.End
                rng.Cells.Merge
            End With

            startingColNum = startingColNum + 2

        Next analyteNo

    Next hdrRow

    ' Restore the top row
    Selection.Tables(1).Rows(1).Range.Paste
End Sub

[stuck]

As a workaround

OK, I'll try that. Meanwhile, if I change:
    With .Borders(wdBorderBottom)
to
    With .Borders(wdBorderLeft)

then although those are not the borders I'm looking for, the code does puts the borders in the correct places.

Ken

[HansV]

It has something to do with the bottom border of the merged cell in the top row, but I don't know why or how.

[stuck]

It has something to do with the bottom border of the merged cell in the top row, but I don't know why or how.

My conclusion too but if you don't know why or how there's no chance I'll ever figure it out

Meanwhile your cut & paste the top row idea works, so I'm happy to have a solution.



Ken

[ChrisGreaves]

There's something wrong with my loops, ...

Maybe there is something wrong with our understanding of ranges of cells in tables?
See my recent post
Cheers
Chris

[HansV]

And see my reply there...

(Chris, your problem has nothing to do with Ken's problem - he is defining a range consisting of cells within the same row)