Underline two besides laying cells in table

[Birch81]

Hello,

I have a problem underlining my table.
I have to besides laying cells that has to be underlined with either a single or a double line. The underlining is not the problem. My problem is that when I have underlined those two cells there is a space between lines?

How do I solve this problem?

Here is some of my code. If you need more I will post it.

Sub CreateTable(strHeader As String, colRange As range, bookmark As String)
Dim table As Word.table
Dim ActiveRows As Integer
Dim offSetRow As Integer
Dim rowCounter As Integer
Dim cellCounter As Integer
Dim krCounter As Integer
Dim sum As String
Dim dummy As String
Dim productType As String
Dim test As Integer
ActiveRows = 0
krCounter = 0
cellCounter = 1
offSetRow = 1
rowCounter = 1


If strHeader <> "" Then
ActiveRows = 1
Else
ActiveRows = 0
End If



For i = 0 To colRange.Rows.Count 'Counts Active Rows

If colRange.Cells(i, 5).Value <> "" And colRange.Cells(i, 5).Value <> 0 Then
ActiveRows = ActiveRows + 1
Else
ActiveRows = ActiveRows
End If
Next

Set table = CreateNewTable(ActiveRows, bookmark) 'Create Table

With table
If strHeader <> "" Then
With .Cell(1, 1).range
.InsertAfter strHeader
.Underline = 1
offSetRow = 2
End With
End If


For Each Cell In colRange

Select Case True
Case cellCounter Mod 5 = 0
sum = Cell
Case cellCounter Mod 4 = 0
dummy = Cell
Case cellCounter Mod 3 = 0
price = Cell
Case cellCounter Mod 2 = 0
nummer = Cell
Case cellCounter Mod 1 = 0
productType = Cell
End Select

If cellCounter Mod 5 = 0 Then
If (Len(sum) <> 0 And Len(sum) <> 1) And sum <> "" Then
With .Cell(offSetRow, 1).range
.InsertAfter DefineProductStrings(productType, nummer, price, strHeader) 'productType 'TestType
End With
With .Cell(offSetRow, 2).range
If krCounter = 0 Or DefineProductStrings(productType, nummer, price, strHeader) = "Ialt" Then

.InsertAfter "kr. "
If bookmark <> "TblTotal" Then
If strHeader <> "" Then
If ActiveRows = offSetRow Then 'Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
End If
End If
ElseIf bookmark = "TblTotal" Then
If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
ElseIf ActiveRows = offSetRow Then
'.Font.Underline = wdUnderlineDouble
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleDouble
End If
End If

Else
.InsertAfter " - "

If bookmark = "TblTotal" Then
If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
End If
End If

'If bookmark <> "TblTotal" Then
' If strHeader <> "" Then
' If ActiveRows - 1 = offSetRow Then
' .Font.Underline = wdUnderlineSingle
' End If
' End If
'End If

End If
krCounter = krCounter + 1
End With

With .Cell(offSetRow, 3).range
If krCounter = 0 Or DefineProductStrings(productType, nummer, price, strHeader) = "Ialt" Then

.InsertAfter Format(sum, "##,##0.00")
.ParagraphFormat.Alignment = wdAlignParagraphRight

If bookmark <> "TblTotal" Then
If strHeader <> "" Then
If ActiveRows = offSetRow Then 'Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
End If
End If
ElseIf bookmark = "TblTotal" Then
If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
ElseIf ActiveRows = offSetRow Then
'.Font.Underline = wdUnderlinedouble
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleDouble
End If
End If

Else
.InsertAfter Format(sum, "##,##0.00")
.ParagraphFormat.Alignment = wdAlignParagraphRight
If bookmark = "TblTotal" Then
If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
'ParagraphFormat.Borders(wdBorderBottom).LineStyle =wdLineStyleSingle.InsertParagraphAfter
End If
End If

'If bookmark <> "TblTotal" Then
' If strHeader <> "" Then
' If ActiveRows - 1 = offSetRow Then
' .Font.Underline = wdUnderlineSingle
' End If
' End If
'End If

End If
End With
End If

cellCounter = 0
If (Len(sum) <> 0 And Len(sum) <> 1) And sum <> "" Then
offSetRow = offSetRow + 1
Else
offSetRow = offSetRow
End If
End If


cellCounter = cellCounter + 1
Next

rowCounter = rowCounter + 1


End With
End Sub



Thanks in advance

[Birch81]

Anyone?