VB 6.0 - Drawing an underline at the end of each record.

[tgifgemini]

Good people,
I need your assistance.
I have a spreadsheet. My objective is to draw a line after writing each record. The purpose of this is for clarity - to denote the end of each record.

Please see attachment for example of my spreadsheet and where I want the line to be. Note: I drew the line manually.

Below is the module that produced the spreadsheet.

ii = 5
     w = 0
    For Each R In xlWksht.Range("A5:M5"): w = w + R.ColumnWidth: Next
    
    rht = xlWksht.Range("A5").RowHeight
    
    Do Until M.qBW.EOF = True
        ii = ii + 2
        xlWksht.Cells(ii, 1).Value = M.qBW![Req No]
        xlWksht.Cells(ii, 2).Value = M.qBW![Description]
        xlWksht.Cells(ii, 3).Value = M.qBW![ClientName] & Chr(10) & M.qBW![Status]
        xlWksht.Cells(ii, 4).Value = M.qBW![P L] & Chr(10) & M.qBW![TotalProg1Hrs]

        SrchCriteria = "[Name]= " & "'" & M.qBW![Personnel2] & "'"
        rsinPers.FindFirst SrchCriteria
        If rsinPers.NoMatch = False Then
           xlWksht.Cells(ii, 5).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg2Hrs]
        End If
        
        SrchCriteria = "[Name]= '" & M.qBW![Personnel3] & "'"
        rsinPers.FindFirst SrchCriteria
        If rsinPers.NoMatch = False Then
           xlWksht.Cells(ii, 6).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg3Hrs]
        End If
        
        SrchCriteria = "[Name]= '" & M.qBW![Personnel4] & "'"
        rsinPers.FindFirst SrchCriteria
        If rsinPers.NoMatch = False Then
           xlWksht.Cells(ii, 7).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg4Hrs]
        End If
        
        SrchCriteria = "[Name]= '" & M.qBW![Personnel5] & "'"
        rsinPers.FindFirst SrchCriteria
        If rsinPers.NoMatch = False Then
           xlWksht.Cells(ii, 8).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg5Hrs]
        End If
        
        SrchCriteria = "[Name]= '" & M.qBW![Personnel6] & "'"
        rsinPers.FindFirst SrchCriteria
        If rsinPers.NoMatch = False Then
           xlWksht.Cells(ii, 9).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg6Hrs]
        End If
        
        xlWksht.Cells(ii, 10).Value = "-" & Chr(10) & M.qBW.Fields("Per Hrs")
        xlWksht.Cells(ii, 11).Value = M.qBW.Fields("EstimatedTotalHours") & Chr(10) & M.qBW.Fields("Tot Hrs")
        xlWksht.Cells(ii, 12).Value = M.qBW![Start Date] & Chr(10) & M.qBW![Start Date]
        xlWksht.Cells(ii, 13).Value = M.qBW![End Date] & Chr(10) & M.qBW![End  Date]
        xlWksht.Cells(ii + 1, 1).Value = "Comments:" & Chr(10) & "'" & xlApp.Clean(Trim(M.qBW![Comments]))
        
        With xlWksht.Range(Cells(ii + 1, 1), Cells(ii + 1, 5))
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlTop
            .WrapText = True
            .Orientation = 0
            .IndentLevel = 0
            .Font.Size = 10
            .MergeCells = True
            .RowHeight = .Font.Size * (Len(xlWksht.Range("A" & ii + 1).text) - Len("Comments:")) / w + rht + (rht - .Font.Size)
        End With
        M.qBW.MoveNext
    Loop

Thanks,
tgifgemini.

[tgifgemini]

Hello,
I tweaked it with the code below to accomplish the above objective, but is there a more efficient way of doing it?

xlWksht.Cells(ii + 1, 1).Value = "Comments:" & Chr(10) & "'" & xlApp.Clean(Trim(M.qBW![Comments])) & Chr(10) & "_____________________________________________________________________________________________________________________________"

tgifgemini.

[QVeen72]

Hi,

Check this Code, Write at the end and before the "Loop":

Dim TStr As STring

TStr = "A" & CStr(ii+1) & ":M" & CStr(ii+1)
Range(TStr).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone

REgards
Veena

[tgifgemini]

Hi Veena.
Thanks for your input. I do apppreciate it very much.
Have a wonderful weekend.
tgif.