Spreadsheet - Prints Blank Pages And Unnecessary Underlines

[GiftX]

Hellow everyone,
I am calling/manipulating Excel spreadsheet through VB 6.0. Most of my objectives are accomplished except some cosmetics.
Problem#1:
For example, after running my program to process a single record, when I proceed to print it, it prints the first page containing the processed record. It also prints 5 more blank pages without any record.

Problem#2:
Also, my intention is to print an Underline after writing each record, but the underlines are printed whether a record is written or not.

How can I get it to prints only the area that has data and draw an underline only when a record is processed and written?

Below is my entire module:

 
ii = 5 
w = 0 
For Each R In xlWksht. Range("A5:N5"): 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 = "" 
        xlWksht.Cells(ii, 4).Value = M.qBW![ClientName] & Chr(10) & M.qBW![Status] 
        xlWksht.Cells(ii, 5).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, 6).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, 7).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, 8).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, 9).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, 10).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg6Hrs] 
        End If 
 
        xlWksht.Cells(ii, 11).Value = "-" & Chr(10) & M.qBW.Fields("Per Hrs") 
        xlWksht.Cells(ii, 12).Value = M.qBW.Fields("EstimatedTotalHours") & Chr(10) & M.qBW.Fields("Tot Hrs") 
        xlWksht.Cells(ii, 13).Value = M.qBW![Start  Date] & Chr(10) & M.qBW![Start Date] 
        xlWksht.Cells(ii, 14).Value = M.qBW![End Date] & Chr(10) & M.qBW![End  Date] 
 
        If M.qBW![Comments] = "" Or IsNull(M.qBW![Comments]) Then 
            mystr = "Comments:" & Chr(10) & "NO COMMENTS FOR THIS RECORD!" 
        Else 
            mystr = "Comments:" & "'" & xlApp.Clean(Trim(M.qBW![Comments])) 
        End If 
 
        Do 
            Pos = InStr(Pos + 1, mystr, ":") 
            If Not Pos = 0 Then 
                If Mid(mystr, Pos - 5, 1) = "/" Then 
                    mystr = Left(mystr, Pos - 11) & Chr(10) & Mid(mystr, Pos - 10, 10) & Chr(10) & Mid(mystr, Pos + 1) 
                    Pos = Pos + 2 
                End If 
            End If 
         Loop While Not Pos = 0 
 
 
        xlWksht.Cells(ii + 1, 1).Value = "Comments:" 
        xlWksht.Cells(ii + 1, 2).Value = Mid(mystr, 11) 
 
        With xlWksht.Range(xlWksht.Cells(ii + 1, 2), xlWksht.Cells(ii + 1, 14)) 
            .HorizontalAlignment = xlLeft 
            .VerticalAlignment = xlTop 
            .WrapText = True 
            .Orientation = 0 
            .MergeCells = True 
            .RowHeight = .Font.Size * (Len(xlWksht.Range("A" & ii + 2).text) - Len("Comments:")) / w + rht + (rht - .Font.Size) ' + newlinecnt * .Font.Size
        End With 
 
        xlWksht.Columns("A:A").ColumnWidth = 9.15 
 
         'Draw Underline after each record:
         '---------------------------------
        TStr = "A" & CStr(ii + 1) & ":N" & CStr(ii + 1) 
        xlWksht.Range(TStr).Select 
        If Not IsEmpty(Selection.Range("A1")) Then 'check if first cell is empty
            With xlWksht.Range(TStr).Borders(xlEdgeBottom) 
                .LineStyle = xlDouble 
                .Weight = xlThin 
                .ColorIndex = xlAutomatic 
            End With 
        End If 
        M.qBW.MoveNext 
    Loop 
 
    xlWksht.PageSetup.LeftFooter = " Legend:" & Chr(10) & "See Estimated Actual Tot.Hrs. Column: Top Number = Estimated Hrs. and Bottom Number = Actual Hrs." & Chr(10) & "See Estimated Actual Start/End Dates Columns: Top dates = Estimated Start/End dates and Bottom dates = Actual Start/End dates" 
 
 
    strAnswer =  MsgBox("Would you like to Print this spreadsheet?", vbYesNo, "Print Option") 
 
    If strAnswer = vbYes Then 
        Goto PrintSpreadsheet 
    Else 
        Goto ViewSpreadsheet 
    End If 
 
PrintSpreadsheet: 
     'Set up Print area:
     '-----------------
    xlWksht.PageSetup.PrintArea = xlWksht.Range("A1:" & xlWksht.Cells.SpecialCells(xlCellTypeLastCell).Address) 
 
    xlApp.ActiveWorkbook.Save 
 
    xlApp.Visible = True 
    xlApp.UserControl = True 
 
    Goto CloseAllObjects 
 

Thanks.
GiftX.