VBA formatting in excel

[vba317]

I am having a problem with formatting in excel and I don't know how to resolve it. I have the page setup to repeat the first two rows on the top of each recurring page. The last row of each page has a double line for the whole row. Somehow the double line is showing up on the bottom of the second row of the second and third pages not the first page, it is not supposed to be there. Any help would be appreciated.

'Page Setup
 With goXL.ActiveSheet.PageSetup
  .PrintTitleRows = ("A1" & ":" & "A2")
  .PrintArea = "A1:P" & iEndRow + 1
  .LeftMargin = goXL.Application.InchesToPoints(0.25)
  .RightMargin = goXL.Application.InchesToPoints(0.25)
  .TopMargin = goXL.Application.InchesToPoints(0.4) 'Changed margin from 0.5 to 0.4
  .BottomMargin = goXL.Application.InchesToPoints(0.5)
  .HeaderMargin = goXL.Application.InchesToPoints(0.25)
  .FooterMargin = goXL.Application.InchesToPoints(0.25)
  .LeftFooter = Format(dtmDate, "dddd, mmmm dd, yyyy")
  .RightFooter = "Pages " & "&P"
  .Orientation = xlLandscape
  .Zoom = 80
      With goXL.Sheets("ASOData")
        .Cells(iEndRow + 2, 1).Select
        .HPageBreaks.Add Before:=ActiveCell
         End With
 End With


'Code that calls the doubleline function
'This is part of a loop iEnd is set for the last row
  Call XLFormatDoubleLine(iEndRow, 2, 16)

'Funtion that is being called

Public Sub XLFormatDoubleLine(iRow As Integer, iLeftCol As Integer, iRightCol As Integer)

' ************************************************************************************************
' *** THIS SUB CREATES A DOUBLE LINE IN A GIVEN RANGE OF CELLS ON ACTIVE OBJECT ***
' ************************************************************************************************
Dim strLeftLetter As String
Dim strRightLetter As String

strLeftLetter = ConvColLet(iLeftCol)
strRightLetter = ConvColLet(iRightCol)

With goXL.ActiveSheet.Range("" & (strLeftLetter) & (iRow) & ":" & (strRightLetter) & (iRow) & "").Borders(xlEdgeBottom)
    .LineStyle = xlDouble
    .Weight = xlThick
    .ColorIndex = xlAutomatic
End With

End Sub

 

[SkipVought]

hi,

This is a function of your PAGE BREAKS.

View your sheet in PAGE BREAK MODE and you will see where the breaks occur. You can DRAG the soft breaks to where you need the break to be.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[vba317]

Skip,
After much pain I figured out that I had to use vba to add an extra row below the double line and add a counter and this fixed the report.

Tom

 

[SkipVought]

Other members might benefir from the specifics of what you discovered.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[vba317]

Your are right as usual. I will post my code. The problem I have the print settings set to have rows 1 and 2 repeat on every page, the doubleline would appear at the bottom of line three on each page. I don't know why my solution works but I added an extra line at the end of my report and this fixed the problem. The extra line code is highlighted in red.

Dim strSQL As String
Dim rst As Recordset
Dim Z As Integer
Dim strCurYr As String
Dim strGrpYr As String
Dim iRow As Integer
Dim iBegRow As Integer
Dim iEndRow As Integer
Dim iLoopCnt As Integer
Dim SheetName As Worksheet
Dim dtmDate As Date
Dim Yr As Date
Dim Y As Integer
Dim iColCnt As Integer
Dim iPageBreak As Integer
Dim iYearRowHeight As Integer
Dim iMonthRowHeight As Integer
Dim iNoteRowHeight As Integer
Dim iDataRowHeight As Integer
Dim iTotalRowHeight As Integer
Dim iAverageRowHeight As Integer

dtmDate = Now()
Call XLCreate
If gbXLPresent = True Then
    '******************************************************************************************
    '*******************FIRST SHEET FOR TOTALS*************************************************
    '******************************************************************************************
	'Opens up excel template instance
    With goXL
        '.Application.ScreenUpdating = False
        .Workbooks.Open FileName:="Z:\Adhoc projects\FileName.xlt"
        'Select Sheetname for information to go into.
        .Sheets("SheetName").Select
    End With
	 ' Pull Totals by Month and Year from SQL database
    strSQL = "SELECT pd.yr,asotot.rptpd,pd.mon_nm,Sum(asotot.CaseCnt)as 1,Sum(asotot.Units) as 2,Sum(asotot.ORFlag) as 3,Sum(asotot.ORUnits) as 4," & _
                    "Sum(asotot.Amt) as 5,Sum(asotot.TotPay) as 6,Sum(asotot.TotAdj) as 7,Sum(asotot.CurBal) as 8,Sum(asotot.[3MonChgs]) as 9 " & _
                "FROM dat_DataFile asotot " & _
                    "INNER JOIN dbo_dic_Period pd ON asotot.rptpd = pd.pd " & _
                "GROUP BY pd.yr,asotot.rptpd,pd.mon_nm " & _
                "ORDER BY pd.yr,asotot.rptpd;"
    Set rst = CurrentDb.OpenRecordset(strSQL, dbopensnapshot)
    'Verify the recordcount counter is set at record 1
    If (rst.RecordCount > 0) Then
        With rst
            .MoveLast
            .MoveFirst
        End With
        strCurYr = rst![Yr]
        strGrpYr = rst![Yr]
        'Sets 1st year
        iRow = 5
        iBegRow = 5
        iPageBreak = 1
        With goXL
        'Set up page break for first loop
            If iPageBreak = 1 Then iYearRowHeight = 40
            If iPageBreak = 1 Then iMonthRowHeight = 40
            If iPageBreak = 1 Then iNoteRowHeight = 25
            If iPageBreak = 1 Then iDataRowHeight = 22
            If iPageBreak = 1 Then iTotalRowHeight = 22
            If iPageBreak = 1 Then iAverageRowHeight = 22
			
			'Setup all Columns for excel template
            Call XLFormatColWidth(1, 1, 8)
            Call XLFormatColWidth(2, 2, 14)
            Call XLFormatColWidth(3, 4, 9)
            Call XLFormatColWidth(5, 5, 8)
            Call XLFormatColWidth(6, 6, 7)
            Call XLFormatColWidth(7, 9, 9)
            Call XLFormatColWidth(10, 10, 11)
            Call XLFormatColWidth(11, 14, 9)
            Call XLFormatColWidth(15, 15, 12)
            Call XLFormatColWidth(16, 16, 9)
			
			 'Set up the first data row of template
        iRow = 5 ' Row starts at 5
        iBegRow = 5 ' First iBegRow
        strCurYr = rst![Yr]
        strGrpYr = rst![Yr]
        'Counter to loop through all records
        For Z = 1 To rst.RecordCount
            With goXL.ActiveSheet
                    Call XLFormatRowHeight(iRow, iRow, iDataRowHeight)  'Set up row height for rows 3 & 4 excel template AnestheticSolutions_2.xlt
                    .Cells(iRow, 2).Value = "'" & (rst![mon_nm]) & " " & (rst![Yr])
                    .Cells(iRow, 3) = rst![1]
                    .Cells(iRow, 4) = rst![2]
                    .Cells(iRow, 5) = rst![3]
                    .Cells(iRow, 6) = rst![4]
                    'Excel formula =IF(ISBLANK(E5),0,F5/E5)
                    .Cells(iRow, 7).Formula = "=if(ISBLANK(E" & (iRow) & "),0,F" & (iRow) & "/E" & (iRow) & ")"
                    .Cells(iRow, 8) = rst![5]
                    .Cells(iRow, 9) = rst![6]
                    '.Cells(iRow, 9).Formula = "=if(ISBLANK(I" & (iRow) & "),0,I" & (iRow) & ")"
                    .Cells(iRow, 10) = rst![7]
                    'Excel Formula =IF(ISBLANK(D5),0,I5/D5)
                    .Cells(iRow, 11).Formula = "=if(ISBLANK(D" & (iRow) & "),0,I" & (iRow) & "/D" & (iRow) & ")"
                    'Excel Formula =IF(ISBLANK(F5),0,I5/F5)
                    .Cells(iRow, 12).Formula = "=if(ISBLANK(F" & (iRow) & "),0,I" & (iRow) & "/F" & (iRow) & ")"
                    'Excel Formula =IF(ISBLANK(I6),0,I6/H6)
                    .Cells(iRow, 13).Formula = "=if(ISBLANK(I" & (iRow) & "),0,I" & (iRow) & "/H" & (iRow) & ")"
                    '=IF((I6+J6)=0,0,I6/(I6+J6))
                    .Cells(iRow, 14).Formula = "=IF((I" & (iRow) & "+J" & (iRow) & ")=0,0,I" & (iRow) & "/(I" & (iRow) & "+J" & (iRow) & "))"
                    .Cells(iRow, 15) = rst![8]
                    'Excel Formula =IF(ISBLANK(O6),=O6/(AA6/AB6)
                    .Cells(iRow, 16).Formula = "=if(ISBLANK(O" & (iRow) & "),0,O" & (iRow) & "/(AA" & (iRow) & "/AB" & (iRow) & "))"
                    .Cells(iRow, 27) = rst![9]
                    .Cells(iRow, 28) = Daysper3Mon(rst![rptpd])
                End With
            iRow = iRow + 1
            rst.MoveNext
            If Not rst.EOF Then
                strCurYr = rst![Yr]
                If (strCurYr <> strGrpYr) Then
                        iColCnt = 2
                        iEndRow = iRow + 1
                        'Set up Formatting for Totals and Averages
                        Call XLFormatBottomLine(iRow - 1, 2, 16)
                        Call XLFormatFontBold(iRow, iEndRow, 2, 2)
                        Call XLFormatBottomLine(iRow, 2, 16)
                        Call XLFormatFontBold(iRow, iEndRow, 2, 2)
                        Call XLFormatFontBold(iRow + 1, iEndRow, 2, 2)
                        'Sets Year at top of Sheet
                        strGrpYr = strCurYr
                        'Formatting for last Month of data on excel template AnestheticSolutions.xlt
                        iColCnt = 1
                            Call ConvColLet(iColCnt)
                        With goXL
                            'This Code adds final two totals and averages columns on last data
                                For iColCnt = 2 To 15
                                    Call ConvColLet(iColCnt)
                                    If iColCnt = 2 Then .ActiveSheet.Cells(iEndRow - 1, iColCnt).Value = "Totals" ' Puts Totals in col 2
                                    If iColCnt = 2 Then Call XLFormatRowHeight(iEndRow - 1, iEndRow, iTotalRowHeight)  'Set up row height for row 1 on excel template AnestheticSolutions_2.xlt
                                    If iColCnt = 2 Then .ActiveSheet.Cells(iEndRow, iColCnt).Value = "Averages"  'Puts averages in Col 2
                                    'Creates doubleline on bottom of Averages on first loop
                                    If iColCnt = 2 Then Call XLFormatDoubleLine(iEndRow, 2, 16)
                                    If iRow < 12 Then .ActiveSheet.Cells(iEndRow - 1, iColCnt + 1).Formula = "=SUM(" & (ConvColLet(iColCnt + 1)) & (iBegRow) & ":" & (ConvColLet(iColCnt + 1)) & (iEndRow - 2) & ")"
                                    If iRow < 12 Then .ActiveSheet.Cells(iEndRow, iColCnt + 1).Formula = "=AVERAGE(" & (ConvColLet(iColCnt + 1)) & (iBegRow) & ":" & (ConvColLet(iColCnt + 1)) & (iEndRow - 2) & ")"
                                    If iRow > 12 Then .ActiveSheet.Cells(iEndRow - 1, iColCnt + 1).Formula = "=SUM(" & (ConvColLet(iColCnt + 1)) & (iBegRow) & ":" & (ConvColLet(iColCnt + 1)) & (iEndRow - 2) & ")"
                                    If iRow > 12 Then .ActiveSheet.Cells(iEndRow, iColCnt + 1).Formula = "=AVERAGE(" & (ConvColLet(iColCnt + 1)) & (iBegRow) & ":" & (ConvColLet(iColCnt + 1)) & (iEndRow - 2) & ")"
                                    Call XLFormatDoubleLine(iEndRow, 2, 16)
                                Next iColCnt
                            'Formatting for extra row at end of page
                            If iEndRow = 27 Or iEndRow = 60 Then .ActiveSheet.Cells(iEndRow + 1, iColCnt + 1).Value = "" 'Add extra row
                            If iEndRow = 27 Or iEndRow = 60 Then Call XLFormatRowHeight(iEndRow + 1, iEndRow + 1, 10) 'Set up row height for last row on excel template AnestheticSolutions_2.xlt
                            'Sets up Formatting for first three rows after initial loop
                            If iEndRow = 27 Then iPageBreak = iPageBreak + 1
                            If iPageBreak > 1 Then iYearRowHeight = 30
                            If iPageBreak > 1 Then iMonthRowHeight = 30
                            If iPageBreak > 1 Then iNoteRowHeight = 25
                            If iPageBreak > 1 Then iDataRowHeight = 17
                            If iPageBreak > 1 Then iTotalRowHeight = 20
                            If iPageBreak > 1 Then iAverageRowHeight = 20
                            'Add additonal iEndRow because of added row at end
                            If iEndRow = 27 Then iEndRow = iEndRow + 1
                            If iEndRow = 60 Then iEndRow = iEndRow + 1
                             'Formatting for third row, Current Year cell after initial loop
                            .ActiveSheet.Cells(iEndRow + 1, 2).Value = "'" & (strCurYr)
                            .ActiveSheet.Cells(iEndRow + 1, 2).VerticalAlignment = xlBottom
                            Call XLFormatRowHeight(iEndRow + 1, iEndRow + 2, iYearRowHeight) 'Set up row height for row 1 on excel template AnestheticSolutions_2.xlt
                            Call XLFormatFontBold(iEndRow + 1, iEndRow + 2, 16, 2)
                            Call XLFormatFontSize(iEndRow + 1, iEndRow + 2, 2, 16, 12)
                            Call XLFormatDoubleLine(iEndRow + 1, 2, 16)
                            'Formatting for fourth row, Month Cell after initial loop
                            .ActiveSheet.Cells((iEndRow + 2), 2).Value = "Month"
                            .ActiveSheet.Cells(iEndRow + 2, 2).VerticalAlignment = xlBottom
                            Call XLFormatFontSize(iEndRow + 2, iEndRow + 1, 2, 2, 12)
                            Call XLFormatDoubleLine(iEndRow + 2, 2, 16)
                            Call XLFormatTextWrap(iEndRow + 1, iEndRow + 2, 1, 16)
                            Call XLFormatFontSize(iEndRow + 1, iEndRow + 2, 3, 16, 10)
                            .ActiveSheet.Cells((iEndRow + 2), 3).Value = "Case Total"
                            .ActiveSheet.Cells((iEndRow + 2), 4).Value = "Units"
                            .ActiveSheet.Cells((iEndRow + 2), 5).Value = "OR Cases"
                            .ActiveSheet.Cells((iEndRow + 2), 6).Value = "OR Units"
                            .ActiveSheet.Cells((iEndRow + 2), 7).Value = "OR Units/ OR Cases"
                            .ActiveSheet.Cells((iEndRow + 2), 8).Value = "Charges"
                            .ActiveSheet.Cells((iEndRow + 2), 9).Value = "Receipts"
                            .ActiveSheet.Cells((iEndRow + 2), 10).Value = "Adjustments"
                            .ActiveSheet.Cells((iEndRow + 2), 11).Value = "Rec Per Unit"
                            .ActiveSheet.Cells((iEndRow + 2), 12).Value = "Rec Per OR Unit"
                            .ActiveSheet.Cells((iEndRow + 2), 13).Value = "Coll Rate"
                            .ActiveSheet.Cells((iEndRow + 2), 14).Value = "Res Rate"
                            .ActiveSheet.Cells((iEndRow + 2), 15).Value = "Receivables"
                            .ActiveSheet.Cells((iEndRow + 2), 16).Value = "Days in AR"
                            iLoopCnt = iLoopCnt + 1
                            End With
                    End If
                End If
           'Add counter for iBegRow
          If iLoopCnt > 0 Then iBegRow = iEndRow + 3
          If iLoopCnt = 1 And iRow = 10 Then iRow = iRow + 4
          If iLoopCnt = 2 And iRow = 26 Then iRow = iRow + 5   'orig iRow+4 changed to +5
          If iLoopCnt = 3 And iRow = 43 Then iRow = iRow + 4   'orig iRow+4 changed to +5
          If iLoopCnt = 4 And iRow = 59 Then iRow = iRow + 5   'orig iRow+4 changed to +5
          If iLoopCnt = 5 And iRow = 76 Then iRow = iRow + 4   'orig iRow+4 changed to +5
          If iLoopCnt = 6 And iRow = 90 Then iRow = iRow + 4   'orig iRow=90
          If iLoopCnt = 7 And iRow = 106 Then iRow = iRow + 4
          If iLoopCnt = 8 Then iRow = iRow + 4
          If iLoopCnt = 9 Then iRow = iRow + 4
          If iLoopCnt = 10 Then iRow = iRow + 4
        Next Z
             iEndRow = iRow + 1
            With goXL
                '.Application.ScreenUpdating = True
                'Sets up formatting for bottom 2 rows
                Call XLFormatBottomLine(iRow - 1, 2, 16)
                Call XLFormatFontBold(iRow, iEndRow, 2, 2)
                Call XLFormatBottomLine(iRow, 2, 16)
                Call XLFormatFontBold(iRow, iEndRow, 2, 2)
                Call XLFormatFontBold(iRow + 1, iEndRow, 2, 2)
              For iColCnt = 2 To 15
                Call ConvColLet(iColCnt)
                If iColCnt = 2 Then .ActiveSheet.Cells(iEndRow - 1, iColCnt).Value = "Totals" ' Puts Totals in col 2
                If iColCnt = 2 Then Call XLFormatRowHeight(iEndRow - 1, iEndRow, iTotalRowHeight) 'Set up row height for row 1 on excel template AnestheticSolutions_2.xlt
                If iColCnt = 2 Then .ActiveSheet.Cells(iEndRow, iColCnt).Value = "Averages"  'Puts averages in Col 2
                If iColCnt = 2 Then Call XLFormatRowHeight(iEndRow, iEndRow + 1, iAverageRowHeight) 'Set up row height for row 1 on excel template AnestheticSolutions_2.xlt
                .ActiveSheet.Cells(iEndRow - 1, iColCnt + 1).Formula = "=SUM(" & (ConvColLet(iColCnt + 1)) & (iBegRow) & ":" & (ConvColLet(iColCnt + 1)) & (iEndRow - 2) & ")"
                Call XLFormatRowHeight(iEndRow - 1, iEndRow, iTotalRowHeight) 'Set up row height for row 1 on excel template AnestheticSolutions_2.xlt
                .ActiveSheet.Cells(iEndRow, iColCnt + 1).Formula = "=AVERAGE(" & (ConvColLet(iColCnt + 1)) & (iBegRow) & ":" & (ConvColLet(iColCnt + 1)) & (iEndRow - 2) & ")"
                Call XLFormatRowHeight(iEndRow, iEndRow + 1, iAverageRowHeight) 'Set up row height for row 1 on excel template AnestheticSolutions_2.xlt
                Call XLFormatDoubleLine(iEndRow, 2, 16)
 [red]               '.ActiveSheet.Cells(iEndRow, iColCnt + 1).Value = "" 'Add extra row
                'Call XLFormatRowHeight(iEndRow + 1, iEndRow, 10) 'Set up row height for last row on excel template AnestheticSolutions_2.xlt [/Red]
              Next iColCnt
            End With
                        'PageSetup for excel template
              With goXL.ActiveSheet.PageSetup
                '.PrintTitleRows = ("A1" & ":" & "A2")
                .PrintArea = "A1:P" & iEndRow + 1
                .LeftMargin = goXL.Application.InchesToPoints(0.25)
                .RightMargin = goXL.Application.InchesToPoints(0.25)
                .TopMargin = goXL.Application.InchesToPoints(0.4) 'Changed margin from 0.5 to 0.4
                .BottomMargin = goXL.Application.InchesToPoints(0.5)
                .HeaderMargin = goXL.Application.InchesToPoints(0.25)
                .FooterMargin = goXL.Application.InchesToPoints(0.25)
                .LeftFooter = Format(dtmDate, "dddd, mmmm dd, yyyy")
                .RightFooter = "Pages " & "&P"
                .Orientation = xlLandscape
                .Zoom = 80
                    With goXL.Sheets("Sheet1")
                    .Cells(iEndRow + 2, 1).Select
                    .HPageBreaks.Add Before:=ActiveCell
                    End With
              End With
    End If
                        Set rst = Nothing
                            'Save Workbook
                            With goXL.ActiveWorkbook
                            'Save the information in an excel file FileName.xls
                            .SaveAs FileName:="Z:\Adhoc projects\FileName" & (MonShortName(CurMon())) & "Total Report" & ".xls"
                            .Close
                            End With
                                Else
                                MsgBox "Can't create Excel Object", vbOKOnly, "Excel not found"
End If
' Close Excel Instance
Call XLKill
' Message it is closed
 MsgBox "Reports Completed.", , "Done!"
End Sub