Back to Papers and Articles
Rendering the results of an Access Database in Excel (The code)
Copyright 2001 Paragon Corporation   ( August 11, 2001)


Back to Rendering the results of an Access Database in Excel

Option Compare Database
Option Explicit
'Module modExcelReport for budget database
Dim xlBudgetSchedule As Excel.Application

Public Sub ChartBudgetPaymentsCategory()
    Dim xlChart As Excel.Chart, xlco As ChartObject
    Dim sqlEncumbrance As String, i As Integer, j As Integer, currentYear As Integer, numberOfQuarters As Integer
    Dim currentRow, currentColumn, currentQuarter As String, categoryChanged As Boolean, currentCategoryID As Integer
    Dim sumPayments, quarterBudget, quarterBudgetTransfer, quarterOriginalBudget, theQuarter As String, theMonth As String, budgetToDate
    Dim Budget, budgetTransfer, originalBudget, currentMonth As String
    Dim aryQuarters(10) As String, theWeekStart As Date, monthIncrement As Integer
    Dim meterReturn As Integer, lngProgress As Long, budgetToDateFormula As String
    Dim firstDayOfMonth As Date 'first day of the next month
    Dim firstDayOfQuarter As Date
    Dim columnLetter As String
    Dim rstPayments As Recordset
    
    Set rstPayments = CurrentDb.OpenRecordset("qryCategoryPaymentsByMonth_CrossTab")
    xlBudgetSchedule.ActiveWorkbook.Worksheets.Add After:=xlBudgetSchedule.ActiveWorkbook.ActiveSheet
    xlBudgetSchedule.ActiveSheet.Name = "Payments"
    

    xlBudgetSchedule.Visible = True
'*** Populate payments
    currentRow = 1
    
    xlBudgetSchedule.ActiveSheet.Cells(currentRow, 1).Value = "Date"
    
    
    For i = 1 To rstPayments.Fields.Count - 1 'Skip month label
        xlBudgetSchedule.ActiveSheet.Cells(currentRow, i + 1).Value = rstPayments.Fields(i).Name
        xlBudgetSchedule.ActiveSheet.Cells(currentRow, i + 1).Font.Bold = True
        xlBudgetSchedule.ActiveSheet.Columns(i + 1).AutoFit
    Next
    
    currentRow = 2
    
    xlBudgetSchedule.ActiveSheet.Cells(currentRow, 1).CopyFromRecordset rstPayments
    currentRow = currentRow + rstPayments.RecordCount
    
    xlBudgetSchedule.ActiveSheet.Range("B2:J100").NumberFormat = "#,##0_);[Red](#,##0)"
    
    
   Set xlChart = xlBudgetSchedule.Charts.Add
   With xlChart
        .ChartWizard Source:=xlBudgetSchedule.Worksheets("Payments").Range("A2:" & ExcelColumnLetters(rstPayments.Fields.Count) & currentRow), _
         Gallery:=xlLine, PlotBy:=xlColumns, _
        CategoryLabels:=1, HasLegend:=1, CategoryTitle:="To Date", ValueTitle:="Total Paid", Title:="Budget Payments By Category"
        .PageSetup.Orientation = xlPortrait
        .Name = "Chart of Payments"
   End With
   
   rstPayments.MoveFirst
    With xlChart.Legend
        .Font.Bold = True
        .Font.Name = "Arial"
        .Font.Size = 7
    End With
    For i = 1 To rstPayments.Fields.Count - 1 'Skip month label
        With xlChart.SeriesCollection(i)
            .Name = rstPayments.Fields(i).Name
        End With
    Next
   
    With xlChart.Axes(xlValue)
       .MinimumScale = "0"
    End With
    
    
    xlBudgetSchedule.Visible = True
    

End Sub

Public Sub BuildBudgetSchedule(aDayInWeek As Date)

    Dim rstCategory As Recordset, rstEncumbrance As Recordset, theWeekEnd As Date
    Dim sqlEncumbrance As String, i As Integer, j As Integer, currentYear As Integer, numberOfQuarters As Integer
    Dim currentRow, currentColumn, currentQuarter As String, categoryChanged As Boolean, currentCategoryID As Integer
    Dim sumPayments, quarterBudget, quarterBudgetTransfer, quarterOriginalBudget, theQuarter As String, theMonth As String, budgetToDate
    Dim Budget, budgetTransfer, originalBudget, currentMonth As String
    Dim aryQuarters(5) As String, theWeekStart As Date, monthIncrement As Integer
    Dim meterReturn As Integer, lngProgress As Long, budgetToDateFormula As String
    Dim firstDayOfMonth As Date 'first day of the next month
    Dim firstDayOfQuarter As Date, tempDate As Date
    Dim columnLetter As String
    
    lngProgress = 0
    meterReturn = SysCmd(acSysCmdInitMeter, "Generating Budget Report ...", 100)
    
    theWeekStart = aDayInWeek - WeekDay(aDayInWeek, vbWednesday) + 1   'Week start's wednesday
    theWeekEnd = theWeekStart + 6
    firstDayOfQuarter = CDate((DatePart("q", theWeekStart) * 3 - 2) & "/1/" & Year(theWeekStart)) 'first day of quarter this day lies in
    firstDayOfMonth = DateAdd("m", 1, theWeekEnd - Day(theWeekEnd) + 1) 'First day of next month
    
    
    currentYear = Year(Date)
    numberOfQuarters = UBound(aryQuarters)
'*** Populate aryQuarters array
   
    For i = 0 To numberOfQuarters
        tempDate = DateAdd("q", i - 1, firstDayOfQuarter)
        aryQuarters(i) = Trim(Year(tempDate) & DatePart("q", tempDate))
    Next
    
    Set rstCategory = CurrentDb.OpenRecordset("SELECT C.CategoryID, C.Category, B.BudgetName " & _
        "FROM CategoryLU C INNER JOIN Budget B ON C.CategoryID = B.BudgetID  ORDER BY C.Category, B.BudgetName", dbOpenSnapshot)
            
    Set xlBudgetSchedule = New Excel.Application
    xlBudgetSchedule.Visible = True
    
    xlBudgetSchedule.Workbooks.Add
    xlBudgetSchedule.ActiveWindow.DisplayGridlines = False 'Do not show grid lines so it looks more like a report
    
    currentRow = 1
    currentColumn = 1
    
    With xlBudgetSchedule.ActiveSheet
        .Cells(currentRow, currentColumn).Value = "BUDGET SCHEDULE"
        .Cells(currentRow, currentColumn).Font.Bold = True
        .Cells(currentRow, currentColumn).Font.Name = "Times New Roman"
        .Cells(currentRow, currentColumn).Font.Size = 11
        .Cells(currentRow, currentColumn).HorizontalAlignment = xlCenter
        
        
        currentRow = currentRow + 1
        .Cells(currentRow, currentColumn).Value = "CASH FLOW PROJECTIONS for next 4 quarters"
        .Cells(currentRow, currentColumn).Font.Bold = True
        .Cells(currentRow, currentColumn).Font.Name = "Times New Roman"
        .Cells(currentRow, currentColumn).Font.Size = 11
        .Cells(currentRow, currentColumn).HorizontalAlignment = xlCenter
        
        currentRow = currentRow + 1
        .Cells(currentRow, currentColumn).Value = "PREPARED " & Now
        .Cells(currentRow, currentColumn).Font.Bold = True
        .Cells(currentRow, currentColumn).Font.Name = "Times New Roman"
        .Cells(currentRow, currentColumn).Font.Size = 11
        .Cells(currentRow, currentColumn).HorizontalAlignment = xlCenter
        
        currentRow = currentRow + 2
        
        xlBudgetSchedule.ActiveWorkbook.Colors(1) = RGB(230, 230, 230) 'define first color in workbook palette to be a light grey shade
        
        currentRow = currentRow + 1
        .Cells(currentRow, currentColumn).Value = "Category"
        .Cells(currentRow, currentColumn).Font.Bold = True
        .Cells(currentRow, currentColumn).Font.Name = "Times New Roman"
        .Cells(currentRow, currentColumn).Font.Size = 11
    End With
    
    'currentColumn = currentColumn + 1
    currentRow = currentRow - 1
    
    i = 0
    
    
    Do Until i > numberOfQuarters
    
            i = i + 1
            currentYear = Left(aryQuarters(i - 1), 4)
        
'*** Heading Section: If we are in the current quarter - need to break this out to start to week , week, rest of quarter ***

            If (Year(theWeekStart) & DatePart("q", theWeekStart)) = aryQuarters(i - 1) Then
                With xlBudgetSchedule.ActiveSheet
                    .Cells(currentRow, currentColumn + i).Value = "Q " & Mid(aryQuarters(i - 1), 5, 1) & " " & currentYear & " Up (to " & theWeekEnd & ")"
                    .Cells(currentRow, currentColumn + i).WrapText = True
                    .Cells(currentRow, currentColumn + i).Font.Bold = True
                    .Cells(currentRow, currentColumn + i).Font.Name = "Times New Roman"
                    .Cells(currentRow, currentColumn + i).Font.Size = 11
                
                    .Cells(currentRow + 1, currentColumn + i).Value = "Paid"
                    .Cells(currentRow + 1, currentColumn + i).Font.Italic = True
                    .Cells(currentRow + 1, currentColumn + i).Font.Name = "Times New Roman"
                    .Cells(currentRow + 1, currentColumn + i).Font.Size = 8
                    .Cells(currentRow + 1, currentColumn + i).HorizontalAlignment = xlCenter
         
                    .Cells(currentRow, currentColumn + i + 1).Value = "Summary As Of Week Ending " & theWeekEnd
                    .Cells(currentRow, currentColumn + i + 1).Font.Bold = True
                    .Cells(currentRow, currentColumn + i + 1).Font.Name = "Times New Roman"
                    .Cells(currentRow, currentColumn + i + 1).Font.Size = 11
                    .Cells(currentRow, currentColumn + i + 1).HorizontalAlignment = xlCenter
                    .Range(Chr(65 + currentColumn + i) & currentRow & ":" & Chr(65 + currentColumn + i + 2) & currentRow).Merge
                    
                    
                    'currentRow = currentRow + 1
                    .Cells(currentRow + 1, currentColumn + i + 1).Value = "Paid To Date"
                    .Cells(currentRow + 1, currentColumn + i + 1).Font.Italic = True
                    .Cells(currentRow + 1, currentColumn + i + 1).Font.Name = "Times New Roman"
                    .Cells(currentRow + 1, currentColumn + i + 1).Font.Size = 8
                    .Cells(currentRow + 1, currentColumn + i + 1).HorizontalAlignment = xlCenter
                    
                    .Cells(currentRow + 1, currentColumn + i + 2).Value = "Budget To Date"
                    .Cells(currentRow + 1, currentColumn + i + 2).Font.Italic = True
                    .Cells(currentRow + 1, currentColumn + i + 2).Font.Bold = True
                    .Cells(currentRow + 1, currentColumn + i + 2).Font.Name = "Times New Roman"
                    .Cells(currentRow + 1, currentColumn + i + 2).Font.Size = 8
                    .Cells(currentRow + 1, currentColumn + i + 2).HorizontalAlignment = xlCenter
                    
                    .Cells(currentRow + 1, currentColumn + i + 3).Value = "Difference To Date"
                    .Cells(currentRow + 1, currentColumn + i + 3).Font.Italic = True
                    .Cells(currentRow + 1, currentColumn + i + 3).Font.Bold = True
                    .Cells(currentRow + 1, currentColumn + i + 3).Font.Name = "Times New Roman"
                    .Cells(currentRow + 1, currentColumn + i + 3).Font.Size = 8
                    .Cells(currentRow + 1, currentColumn + i + 3).HorizontalAlignment = xlCenter
            
                    .Columns(currentColumn + i + 1).Interior.ColorIndex = 1  ' shadow current week and quarter lightgrey - first color in palette
                    .Columns(currentColumn + i + 2).Interior.ColorIndex = 1
                    .Columns(currentColumn + i + 3).Interior.ColorIndex = 1
                    
            'Put in column headings for rest of month in current week
    
                    .Cells(currentRow, currentColumn + i + 4).Value = (theWeekStart + 7) & " Until End " & Format(theWeekStart + 7, "mmmm") & " " & currentYear
                    .Cells(currentRow, currentColumn + i + 4).WrapText = True
                    .Cells(currentRow, currentColumn + i + 4).Font.Bold = True
                    .Cells(currentRow, currentColumn + i + 4).Font.Name = "Times New Roman"
                    .Cells(currentRow, currentColumn + i + 4).Font.Size = 11
                    
                    .Cells(currentRow + 1, currentColumn + i + 4).Value = "Budget"
                    .Cells(currentRow + 1, currentColumn + i + 4).Font.Italic = True
                    .Cells(currentRow + 1, currentColumn + i + 4).Font.Bold = True
                    .Cells(currentRow + 1, currentColumn + i + 4).Font.Name = "Times New Roman"
                    .Cells(currentRow + 1, currentColumn + i + 4).Font.Size = 8
                    .Cells(currentRow + 1, currentColumn + i + 4).HorizontalAlignment = xlCenter
                End With
                
                currentColumn = currentColumn + 3
                
        '*** Put in column headings for rest of months in current quarter, 2 quarters after that (by month)
                monthIncrement = 1
                j = i + 2
                
            '*** Heading: Loop until we've reached end of Budget or passed thru 2 full quarters + remaining of this quarter ***
                Do Until i > numberOfQuarters Or monthIncrement = (8 + DatePart("q", theWeekEnd) * 3 - Month(theWeekEnd) - 1)
                
                    firstDayOfMonth = DateAdd("m", monthIncrement, CDate(Month(theWeekEnd) & "/1/" & Year(theWeekEnd)))
                    currentMonth = Month(firstDayOfMonth)
                    currentYear = Year(firstDayOfMonth)
                    
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + j).Value = "'" & Format(firstDayOfMonth, "mmm yyyy")
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + j).Font.Bold = True
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + j).Font.Name = "Times New Roman"
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + j).Font.Size = 11
                
                    theQuarter = Year(theWeekStart) & DatePart("q", theWeekStart)
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + j).Value = "Budget"
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + j).Font.Italic = True
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + j).Font.Bold = True
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + j).Font.Name = "Times New Roman"
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + j).Font.Size = 8
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + j).HorizontalAlignment = xlCenter
                    
                    monthIncrement = monthIncrement + 1
                    j = j + 1
                    
                    If currentMonth = 1 Or currentMonth = 4 Or currentMonth = 7 Or currentMonth = 10 Then
                            i = i + 1
                    End If
                    
                    If i = numberOfQuarters Then
                        Exit Do
                    End If
                    
                Loop
                
                currentColumn = currentColumn + monthIncrement - 2
                    
                
            Else '***Heading: just a quarter ***
                
                xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).Value = "Q" & Right(aryQuarters(i - 1), 1) & " " & currentYear
                xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).Font.Bold = True
                xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).Font.Name = "Times New Roman"
                xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).Font.Size = 11
                
                theQuarter = Year(theWeekStart) & DatePart("q", theWeekStart)
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).Value = _
                    IIf(Format(theWeekStart, "yyyyq") < aryQuarters(i - 1), "Budget", "Paid")
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).Font.Italic = True
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).Font.Bold = True
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).Font.Name = "Times New Roman"
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).Font.Size = 8
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).HorizontalAlignment = xlCenter
                
            End If
    Loop
    
    currentColumn = currentColumn + i
    
'Print total header column
    
    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Value = "TOTAL"
    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Font.Bold = True
    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Font.Name = "Times New Roman"
    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Font.Size = 11
    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).HorizontalAlignment = xlCenter
    
    currentRow = currentRow + 3
    
    currentColumn = 2
    
    lngProgress = 20
    meterReturn = SysCmd(acSysCmdUpdateMeter, lngProgress)
    
    currentCategoryID = 0
    
    Do Until rstCategory.EOF
    
    'Put in category header if starting a new category
        If rstCategory!CategoryID <> currentCategoryID Then
            currentCategoryID = rstCategory!CategoryID
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, 1).Value = " " & rstCategory!Category
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, 1).Font.Bold = True
            
            currentRow = currentRow + 1
        End If
        
    'List all Budget Items for this category
        xlBudgetSchedule.ActiveSheet.Cells(currentRow, 1).Value = "   " & rstCategory!BudgetName
        xlBudgetSchedule.ActiveSheet.Cells(currentRow, 1).Font.Bold = True
        xlBudgetSchedule.ActiveSheet.Cells(currentRow, 1).Font.Italic = True
        
        currentRow = currentRow + 1
     
        
'Put in total rows for category - only if starting a new category - so need to rstCategory Movenext here

        rstCategory.MoveNext

        
'Using this convoluted way because a straight if then would do second test at eof and cause error

        If rstCategory.EOF Then
            categoryChanged = True
        Else
            categoryChanged = (rstCategory!CategoryID <> currentCategoryID)
        End If
        
        rstCategory.MovePrevious 'go to previous because running total for previous category - because skipped up one to see what next was
        
        If categoryChanged Then
            
    'Total headings
            currentColumn = 1
            
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Value = "  Total Paid "
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Font.Bold = True
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Font.Italic = True
        
            currentRow = currentRow + 1
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Value = "  Total Original Budget "
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Font.Bold = True
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Font.Italic = True
            
            currentRow = currentRow + 1
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Value = "  Total Budget Transfer "
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Font.Bold = True
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Font.Italic = True
        
            currentRow = currentRow + 1
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Value = "  Total Revised Cumulative Budget"
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Font.Bold = True
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn).Font.Italic = True
            
            xlBudgetSchedule.ActiveSheet.Range("A" & currentRow & ":P" & currentRow).Borders(9).LineStyle = 1 'Draw a horizontal line
            
            currentRow = currentRow - 3
        
    '*** Begin totals section  ***
            i = 0
            Do Until i > numberOfQuarters
            
                i = i + 1
            
        'If quarter we are up to is quarter week start is in then break into three(quarter up to, current week, remainder of month)
                If Year(theWeekStart) & DatePart("q", theWeekStart) = aryQuarters(i - 1) Then
                
                    firstDayOfQuarter = CDate((DatePart("q", theWeekStart) * 3 - 2) & "/1/" & Year(theWeekStart)) 'first day of quarter this day lies in
                    firstDayOfMonth = DateAdd("m", 1, theWeekEnd - Day(theWeekEnd) + 1) 'First day of next month
            
            'Paid during quarter up to week end this week
                    sumPayments = DSum("PaymentAmt", "qryPayments", "PaymentDate<= #" & theWeekEnd & "# " & _
                        " And Year(PaymentDate) & DatePart('q', PaymentDate) = '" & aryQuarters(i - 1) & "' And CategoryID=" & rstCategory!CategoryID)
                    
                    originalBudget = DSum("BudgetAmount", "qryBudgetAmounts", "[EffectiveStart] < #" & firstDayOfMonth & "#" & _
                        " And Year(EffectiveStart) & DatePart('q', EffectiveStart) = '" & aryQuarters(i - 1) & _
                            "' And Amendment = False And CategoryID=" & rstCategory!CategoryID)
                            
                    originalBudget = IIf(IsNull(originalBudget), 0, originalBudget)
                            
                            
                    Budget = DSum("BudgetAmount", "qryBudgetAmounts", "EffectiveStart < #" & firstDayOfMonth & "#" & _
                        " And Year(EffectiveStart) & DatePart('q', EffectiveStart) = '" & aryQuarters(i - 1) & _
                            "' And CategoryID=" & rstCategory!CategoryID)
                            
                    Budget = IIf(IsNull(Budget), 0, Budget)
                    budgetTransfer = Budget - originalBudget
                    
                
                'Set Paid total, Budget Original, Budget Transfers
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).Value = _
                                    IIf(IsNull(sumPayments), 0, sumPayments)
                    
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).Formula = _
                                "=" & originalBudget & "*" & DateDiff("d", firstDayOfQuarter, theWeekEnd) / DateDiff("d", firstDayOfQuarter, firstDayOfMonth)
                                
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).Formula = _
                                "=" & budgetTransfer & "*" & DateDiff("d", firstDayOfQuarter, theWeekEnd) / DateDiff("d", firstDayOfQuarter, firstDayOfMonth)
                                
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).BorderAround Weight:=xlMedium
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).BorderAround Weight:=xlMedium
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).BorderAround Weight:=xlMedium
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).BorderAround Weight:=xlMedium
                    
        'current week column
                    currentColumn = currentColumn + 1
            'Actual paid column - up to this week - no longer show for individual encumbrances
                    sumPayments = DSum("PaymentAmt", "qryPayments", "PaymentDate<=#" & theWeekEnd & "# And CategoryID=" & rstCategory!CategoryID)
                        
                
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).Value = sumPayments
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).BorderAround Weight:=xlThick
                
            'Budget to date
                    currentColumn = currentColumn + 1
                    budgetToDateFormula = "=Sum(" & _
                        "B" & currentRow + 1 & ":" & Chr(65 + currentColumn + i - 3) & (currentRow + 2) & ")"
                   
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).Formula = budgetToDateFormula
                    
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).BorderAround Weight:=xlThick
                                
            'Budget - paid
                    currentColumn = currentColumn + 1
       
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).Formula = _
                        "=" & Chr(65 + currentColumn + i - 2) & currentRow + 3 & " - " & Chr(65 + currentColumn + i - 3) & (currentRow + 3)
                    
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).BorderAround Weight:=xlThick
                                
    '*** Totals Section: Remainder of month - ***
                    currentColumn = currentColumn + 1
                    currentMonth = Year(theWeekStart) & DatePart("m", theWeekStart)
                   
                
            'budget for remainder of month
                        
                    originalBudget = DSum("BudgetAmount", "qryBudgetAmounts", "[EffectiveStart] < #" & firstDayOfMonth & "#" & _
                        " And Year(EffectiveStart) & DatePart('q', EffectiveStart) = '" & aryQuarters(i - 1) & _
                            "' And Amendment = False And CategoryID=" & rstCategory!CategoryID)
                            
                    originalBudget = IIf(IsNull(originalBudget), 0, originalBudget)
                            
                            
                    Budget = DSum("BudgetAmount", "qryBudgetAmounts", "[EffectiveStart] < #" & firstDayOfMonth & "#" & _
                        " And Year(EffectiveStart) & DatePart('q', EffectiveStart) = '" & aryQuarters(i - 1) & _
                            "' And CategoryID=" & rstCategory!CategoryID)
                            
                    Budget = IIf(IsNull(Budget), 0, Budget)
                    budgetTransfer = Budget - originalBudget
                            
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).Formula = _
                                "=" & originalBudget & "*" & DateDiff("d", theWeekEnd, firstDayOfMonth) / DateDiff("d", firstDayOfQuarter, firstDayOfMonth)
                                
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).Formula = _
                                "=" & budgetTransfer & "*" & DateDiff("d", theWeekEnd, firstDayOfMonth) / DateDiff("d", firstDayOfQuarter, firstDayOfMonth)
                    
                        
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).Value = _
                                "=" & Budget & "*" & DateDiff("d", theWeekEnd, firstDayOfMonth) / DateDiff("d", firstDayOfQuarter, firstDayOfMonth)
                        
                    
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).BorderAround Weight:=xlMedium
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).BorderAround Weight:=xlMedium
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).BorderAround Weight:=xlMedium
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).BorderAround Weight:=xlMedium
                    
     '*** Totals: Increment by month instead of quarters for rest of quarter and 2 quarters after - will go here ****
                     monthIncrement = 1
                     j = i + 1
                
            '*** Loop until we've reached end of Budget or passed thru 2 full quarters + remaining of this quarter
                        
                    Do Until i > numberOfQuarters Or monthIncrement = (8 + DatePart("q", theWeekEnd) * 3 - Month(theWeekEnd) - 1)
                
                        firstDayOfMonth = DateAdd("m", monthIncrement, CDate(Month(theWeekEnd) & "/1/" & Year(theWeekEnd)))
                        currentMonth = Month(firstDayOfMonth)
                        currentYear = Year(firstDayOfMonth)
                        
                        sumPayments = DSum("PaymentAmt", "qryPayments", "Val(Year(PaymentDate)& DatePart('m', PaymentDate)) = '" & currentYear & currentMonth & _
                            "' And CategoryID=" & rstCategory!CategoryID)
                        
                        sumPayments = IIf(IsNull(sumPayments), 0, sumPayments)
                         
                        quarterBudget = DSum("BudgetAmount", "qryBudgetAmounts", "CategoryID=" & rstCategory!CategoryID & _
                            " And Year(EffectiveStart) & DatePart('m', EffectiveStart) = '" & currentYear & currentMonth & "'")
                        
                        quarterOriginalBudget = DSum("BudgetAmount", "qryBudgetAmounts", "CategoryID=" & rstCategory!CategoryID & _
                            " And Amendment = False And Year(EffectiveStart) & DatePart('m', EffectiveStart) = '" & currentYear & currentMonth & "'")
                            
                        quarterOriginalBudget = IIf(IsNull(quarterOriginalBudget), 0, quarterOriginalBudget)
                        quarterBudget = IIf(IsNull(quarterBudget), 0, quarterBudget)
                        quarterBudgetTransfer = quarterBudget - quarterOriginalBudget
                    
                        xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + j).Value = _
                                    sumPayments
                      
                        xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + j).Value = _
                                quarterOriginalBudget
                                
                        xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + j).Value = _
                                quarterBudgetTransfer
                                
                        xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + j).Value = _
                                quarterBudgetTransfer
                                   
                        xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + j).Value = _
                                quarterBudget
                   
                                
                        xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + j).BorderAround Weight:=xlThin
                        xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + j).BorderAround Weight:=xlThin
                        xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + j).BorderAround Weight:=xlThin
                        xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + j).BorderAround Weight:=xlThin
                
                        monthIncrement = monthIncrement + 1
                        j = j + 1
                        
                        If currentMonth = 1 Or currentMonth = 4 Or currentMonth = 7 Or currentMonth = 10 Then
                            i = i + 1
                        End If
                    
                        If i = numberOfQuarters Then
                            Exit Do
                        End If
                    
                    Loop
                    
                    currentColumn = currentColumn + monthIncrement - 3
                  
               Else
    'Other quarters
                                
                    sumPayments = DSum("PaymentAmt", "qryPayments", "Val(Year([PaymentDate])& DatePart('q', [PaymentDate])) = " & aryQuarters(i - 1) & _
                        " And CategoryID=" & rstCategory!CategoryID)
                        
                    sumPayments = IIf(IsNull(sumPayments), 0, sumPayments)
                         
                    quarterBudget = DSum("BudgetAmount", "qryBudgetAmounts", "CategoryID=" & rstCategory!CategoryID & _
                        " And Year(EffectiveStart) & DatePart('q', EffectiveStart) = '" & aryQuarters(i - 1) & "'")
                        
                    quarterOriginalBudget = DSum("BudgetAmount", "qryBudgetAmounts", "CategoryID=" & rstCategory!CategoryID & _
                        " And Amendment = False And Year(EffectiveStart) & DatePart('q', EffectiveStart) = '" & aryQuarters(i - 1) & "'")
                            
                    quarterOriginalBudget = IIf(IsNull(quarterOriginalBudget), 0, quarterOriginalBudget)
                    quarterBudget = IIf(IsNull(quarterBudget), 0, quarterBudget)
                    quarterBudgetTransfer = quarterBudget - quarterOriginalBudget
                            
                    
            'Paid total, Budget total
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).Value = _
                                    sumPayments
            
                                
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).Value = _
                                quarterOriginalBudget
                                
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).Value = _
                                quarterBudgetTransfer
                                
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).Value = _
                                quarterBudgetTransfer
                                
                   If Year(theWeekStart) & DatePart("q", theWeekStart) < aryQuarters(i - 1) Then 'only print revised cum for future quarters
                                
                        xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).Value = _
                                quarterBudget
                   End If
                                
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).BorderAround Weight:=xlThin
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).BorderAround Weight:=xlThin
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).BorderAround Weight:=xlThin
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).BorderAround Weight:=xlThin
                                
                    'i = i + 1
                                   
                End If
            
            Loop
            
    '***------Total of totals column section -----------------*****
    'set formulas - to just sum across or difference
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).Formula = _
                "=Sum(B" & currentRow & ":" & Chr(64 + currentColumn + i - 1) & currentRow & ")"
                
            xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).Formula = _
                "=Sum(B" & (currentRow + 1) & ":" & Chr(64 + currentColumn + i - 1) & (currentRow + 1) & ")"
                
            xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).Formula = _
                "=Sum(B" & (currentRow + 2) & ":" & Chr(64 + currentColumn + i - 1) & (currentRow + 2) & ")"
                
            xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).Formula = _
                "=Sum(" & Chr(64 + currentColumn + i) & (currentRow + 1) & ":" & Chr(64 + currentColumn + i) & _
                    (currentRow + 2) & ")"
            
        'Draw borders
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).BorderAround Weight:=xlThin
            xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).BorderAround Weight:=xlThin
            xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).BorderAround Weight:=xlThin
            xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).BorderAround Weight:=xlThick
                   
            currentRow = currentRow + 4
        End If
              
        rstCategory.MoveNext
        
    Loop
    
'*** Grand Totals Headings: Put in total rows for whole sheet ***
'*** Grand Total headings
        currentColumn = 1
        
    With xlBudgetSchedule.ActiveSheet
        .Cells(currentRow, currentColumn).Value = " TOTALS"
        .Cells(currentRow, currentColumn).Font.Bold = True
        currentRow = currentRow + 1
        
        .Cells(currentRow, currentColumn).Value = "     Total Paid "
        .Cells(currentRow, currentColumn).Font.Bold = True
        .Cells(currentRow, currentColumn).Font.Italic = True
        
        currentRow = currentRow + 1
        .Cells(currentRow, currentColumn).Value = "     Total Original Budget "
        .Cells(currentRow, currentColumn).Font.Bold = True
        .Cells(currentRow, currentColumn).Font.Italic = True
        
        currentRow = currentRow + 1
        .Cells(currentRow, currentColumn).Value = "     Total Budget Transfer "
        .Cells(currentRow, currentColumn).Font.Bold = True
        .Cells(currentRow, currentColumn).Font.Italic = True
        
        currentRow = currentRow + 1
        .Cells(currentRow, currentColumn).Value = "     Total Revised Cumulative Budget"
        .Cells(currentRow, currentColumn).Font.Bold = True
        .Cells(currentRow, currentColumn).Font.Italic = True
        
        .Range("A" & currentRow & ":P" & currentRow).Borders(9).LineStyle = 1 'Draw a horizontal line
        currentRow = currentRow - 3
    End With
        
    '*** Begin Grand totals section ***
        i = 0
        Do Until i > numberOfQuarters
            
            i = i + 1
            
    '*** If quarter we are up to is quarter week start is in then break into three(quarter up to, current week, remainder of month)
            If Year(theWeekStart) & DatePart("q", theWeekStart) = aryQuarters(i - 1) Then
                
                firstDayOfQuarter = CDate((DatePart("q", theWeekStart) * 3 - 2) & "/1/" & Year(theWeekStart)) 'first day of quarter this day lies in
                firstDayOfMonth = DateAdd("m", 1, theWeekEnd - Day(theWeekEnd) + 1) 'First day of next month
                
            'Paid during quarter up to week end this week
                sumPayments = DSum("PaymentAmt", "qryPayments", "PaymentDate<= #" & theWeekEnd & "# " & _
                        " And Year(PaymentDate) & DatePart('q', PaymentDate) = '" & aryQuarters(i - 1) & "'")
                    
                originalBudget = DSum("BudgetAmount", "qryBudgetAmounts", "[EffectiveStart] < #" & firstDayOfMonth & "#" & _
                        " And Year(EffectiveStart) & DatePart('q', EffectiveStart) = '" & aryQuarters(i - 1) & _
                            "' And Amendment = False ")
                            
                originalBudget = IIf(IsNull(originalBudget), 0, originalBudget)
                            
                            
                Budget = DSum("BudgetAmount", "qryBudgetAmounts", "EffectiveStart < #" & firstDayOfMonth & "#" & _
                        " And Year(EffectiveStart) & DatePart('q', EffectiveStart) = '" & aryQuarters(i - 1) & _
                            "' ")
                            
                Budget = IIf(IsNull(Budget), 0, Budget)
                budgetTransfer = Budget - originalBudget
                    
                
            'Set Paid total, Budget Original, Budget Transfers
                xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).Value = _
                                    IIf(IsNull(sumPayments), 0, sumPayments)
                                    
                'xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).BorderAround Weight:=xlThin
                    
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).Formula = _
                                "=" & originalBudget & "*" & DateDiff("d", firstDayOfQuarter, theWeekEnd) / DateDiff("d", firstDayOfQuarter, firstDayOfMonth)
                                
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).Formula = _
                                "=" & budgetTransfer & "*" & DateDiff("d", firstDayOfQuarter, theWeekEnd) / DateDiff("d", firstDayOfQuarter, firstDayOfMonth)
                                               
                xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).BorderAround Weight:=xlMedium
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).BorderAround Weight:=xlMedium
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).BorderAround Weight:=xlMedium
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).BorderAround Weight:=xlMedium
                                
    '*** Grand Totals: current week column ***
                currentColumn = currentColumn + 1
            'Actual paid column - up to this week - no longer show for individual encumbrances
                sumPayments = DSum("PaymentAmt", "qryPayments", "PaymentDate<=#" & theWeekStart + 6 & "#")
                        
                
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).Value = sumPayments
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).BorderAround Weight:=xlThick
                
            'Budget to date
                currentColumn = currentColumn + 1

                budgetToDateFormula = "=Sum(" & _
                   "B" & currentRow + 1 & ":" & Chr(65 + currentColumn + i - 3) & (currentRow + 2) & ")"
                   
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).Formula = budgetToDateFormula
                    
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).BorderAround Weight:=xlThick
                                
            'Budget - paid
                currentColumn = currentColumn + 1
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).Formula = _
                    "=" & Chr(65 + currentColumn + i - 2) & currentRow + 3 & " - " & Chr(65 + currentColumn + i - 3) & (currentRow + 3)
                    
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).BorderAround Weight:=xlThick
                                
'*** Grand Totals section: Remainder of month ***
                currentColumn = currentColumn + 1
                
            'Prorate budget
               sumPayments = DSum("PaymentAmt", "qryPayments", "PaymentDate<= #" & theWeekEnd & "# " & _
                        " And Year(PaymentDate) & DatePart('q', PaymentDate) = '" & aryQuarters(i - 1) & "'")
                    
                originalBudget = DSum("BudgetAmount", "qryBudgetAmounts", "[EffectiveStart] < #" & firstDayOfMonth & "#" & _
                        " And Year(EffectiveStart) & DatePart('q', EffectiveStart) = '" & aryQuarters(i - 1) & _
                            "' And Amendment = False ")
                            
                originalBudget = IIf(IsNull(originalBudget), 0, originalBudget)
                            
                            
                Budget = DSum("BudgetAmount", "qryBudgetAmounts", "EffectiveStart < #" & firstDayOfMonth & "#" & _
                        " And Year(EffectiveStart) & DatePart('q', EffectiveStart) = '" & aryQuarters(i - 1) & _
                            "' ")
                            
                Budget = IIf(IsNull(Budget), 0, Budget)
                budgetTransfer = Budget - originalBudget
                
                'xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).Value = _
                 '                   IIf(IsNull(sumPayments), 0, sumPayments)
                    
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).Formula = _
                                "=" & originalBudget & "*" & DateDiff("d", theWeekEnd, firstDayOfMonth) / DateDiff("d", firstDayOfQuarter, firstDayOfMonth)
                                
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).Formula = _
                                "=" & budgetTransfer & "*" & DateDiff("d", theWeekEnd, firstDayOfMonth) / DateDiff("d", firstDayOfQuarter, firstDayOfMonth)
                    
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).Formula = _
                    "=" & Budget & "*" & DateDiff("d", theWeekEnd, firstDayOfMonth) / DateDiff("d", firstDayOfQuarter, firstDayOfMonth)
                    
                xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).BorderAround Weight:=xlMedium
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).BorderAround Weight:=xlMedium
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).BorderAround Weight:=xlMedium
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).BorderAround Weight:=xlMedium
                
'*** Grand Totals section: Put in total month columns for rest of months in current quarter, 2 quarters after that (by month)
                monthIncrement = 1
                j = i + 1
                
'*** Grand Totals section: Loop until we've reached end of Budget or passed thru 2 full quarters + remaining of this quarter
                        
                Do Until i > numberOfQuarters Or monthIncrement = (8 + DatePart("q", theWeekEnd) * 3 - Month(theWeekEnd) - 1)
                
                    firstDayOfMonth = DateAdd("m", monthIncrement, CDate(Month(theWeekEnd) & "/1/" & Year(theWeekEnd)))
                    currentMonth = Month(firstDayOfMonth)
                    currentYear = Year(firstDayOfMonth)
                        
                    sumPayments = DSum("PaymentAmt", "qryPayments", "Val(Year(PaymentDate)& DatePart('m', PaymentDate)) = '" & currentYear & currentMonth & _
                            "'")
                        
                    sumPayments = IIf(IsNull(sumPayments), 0, sumPayments)
                         
                    quarterBudget = DSum("BudgetAmount", "qryBudgetAmounts", _
                            " Year(EffectiveStart) & DatePart('m', EffectiveStart) = '" & currentYear & currentMonth & "'")
                        
                    quarterOriginalBudget = DSum("BudgetAmount", "qryBudgetAmounts", _
                            "Amendment = False And Year(EffectiveStart) & DatePart('m', EffectiveStart) = '" & currentYear & currentMonth & "'")
                            
                    quarterOriginalBudget = IIf(IsNull(quarterOriginalBudget), 0, quarterOriginalBudget)
                    quarterBudget = IIf(IsNull(quarterBudget), 0, quarterBudget)
                    quarterBudgetTransfer = quarterBudget - quarterOriginalBudget
                    
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + j).Value = _
                                    sumPayments
                      
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + j).Value = _
                                quarterOriginalBudget
                                
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + j).Value = _
                                quarterBudgetTransfer
                                
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + j).Value = _
                                quarterBudgetTransfer
                                   
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + j).Value = _
                                quarterBudget
                   
                                
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + j).BorderAround Weight:=xlThin
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + j).BorderAround Weight:=xlThin
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + j).BorderAround Weight:=xlThin
                    xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + j).BorderAround Weight:=xlThin
                
                    monthIncrement = monthIncrement + 1
                    j = j + 1
                        
                    If currentMonth = 1 Or currentMonth = 4 Or currentMonth = 7 Or currentMonth = 10 Then
                        i = i + 1
                    End If
                    
                    If i = numberOfQuarters Then
                        Exit Do
                    End If
                    
                Loop
                    
                currentColumn = currentColumn + monthIncrement - 3
                  
                  
            Else
'*** Grand Totals: Other quarters
                                
                sumPayments = DSum("PaymentAmt", "qryPayments", "Val(Year(PaymentDate)& DatePart('q', PaymentDate)) = " & aryQuarters(i - 1))
                         
                quarterBudget = DSum("BudgetAmount", "qryBudgetAmounts", "Year(EffectiveStart) & DatePart('q', EffectiveStart) = '" & aryQuarters(i - 1) & "'")
                    
                    
                quarterOriginalBudget = DSum("BudgetAmount", "qryBudgetAmounts", _
                        "Year(EffectiveStart) & DatePart('q', EffectiveStart) = '" & aryQuarters(i - 1) & _
                            "' And Amendment = False ")
                            
                quarterOriginalBudget = IIf(IsNull(quarterOriginalBudget), 0, quarterOriginalBudget)
                            
                quarterBudget = IIf(IsNull(quarterBudget), 0, quarterBudget)
                quarterBudgetTransfer = quarterBudget - quarterOriginalBudget
                    
'***  Grand Totals: Paid total, Budget total
                xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).Value = _
                                IIf(IsNull(sumPayments), 0, sumPayments)
                                
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).Value = _
                                quarterOriginalBudget
                                
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).Value = _
                                quarterBudgetTransfer
                                
                If Year(theWeekStart) & DatePart("q", theWeekStart) < aryQuarters(i - 1) Then 'only print revised cum for future quarters
                                
                        xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).Value = _
                                quarterBudget
                End If
                                
                xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).BorderAround Weight:=xlThin
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).BorderAround Weight:=xlThin
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).BorderAround Weight:=xlThin
                xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).BorderAround Weight:=xlThin
            End If
            
        Loop
            
'***------Total column of grand totals row section -----------------*****
       'set formulas - to just sum across
        columnLetter = Chr(64 + currentColumn + i - 1)
        xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).Formula = _
                "=Sum(B" & currentRow & ":" & columnLetter & currentRow & ")"
                
        xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).Formula = _
                "=Sum(B" & (currentRow + 1) & ":" & columnLetter & (currentRow + 1) & ")"
                
        xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).Formula = _
                "=Sum(B" & (currentRow + 2) & ":" & columnLetter & (currentRow + 2) & ")"
                
        columnLetter = Chr(64 + currentColumn + i)
                
        xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).Formula = _
                "=Sum(" & columnLetter & (currentRow + 1) & ":" & columnLetter & _
                    (currentRow + 2) & ")"
            
            
'*** Draw borders
            xlBudgetSchedule.ActiveSheet.Cells(currentRow, currentColumn + i).BorderAround Weight:=xlThin
            xlBudgetSchedule.ActiveSheet.Cells(currentRow + 1, currentColumn + i).BorderAround Weight:=xlThin
            xlBudgetSchedule.ActiveSheet.Cells(currentRow + 2, currentColumn + i).BorderAround Weight:=xlThin
            xlBudgetSchedule.ActiveSheet.Cells(currentRow + 3, currentColumn + i).BorderAround Weight:=xlThick
    
    meterReturn = SysCmd(acSysCmdUpdateMeter, 90)
    
    xlBudgetSchedule.ActiveSheet.Range("B1:" & columnLetter & "150").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
'Autofit to hold all numbers and text across
    xlBudgetSchedule.ActiveSheet.Range("A5:" & columnLetter & "150").Columns.AutoFit
    
    'Set Heading to take up full top 3 rows
    xlBudgetSchedule.ActiveSheet.Range("A1:" & columnLetter & "1").Merge
    xlBudgetSchedule.ActiveSheet.Range("A2:" & columnLetter & "2").Merge
    xlBudgetSchedule.ActiveSheet.Range("A3:" & columnLetter & "3").Merge
    xlBudgetSchedule.ActiveSheet.Range("A4:" & columnLetter & "4").Merge
 
    xlBudgetSchedule.ActiveSheet.Range("A6:" & columnLetter & "6").Borders(9).LineStyle = 1 'Draw a horizontal line
  
    
    With xlBudgetSchedule.ActiveSheet.PageSetup
            .Orientation = xlLandscape
            .Zoom = False 'Force to use fit to page
            .FitToPagesWide = 1
            .FitToPagesTall = 5
            .PrintGridlines = False
            .LeftMargin = xlBudgetSchedule.InchesToPoints(0.25)
            .RightMargin = xlBudgetSchedule.InchesToPoints(0.25)
            .TopMargin = xlBudgetSchedule.InchesToPoints(0.25)
            .BottomMargin = xlBudgetSchedule.InchesToPoints(0.25)
            .PrintTitleRows = xlBudgetSchedule.ActiveSheet.Range("A1:A6").Address 'Print the first 6 rows as the header on each sheet
            .PrintArea = "$A$1:" & "$" & columnLetter & "$" & (currentRow + 3)
    End With
    
    meterReturn = SysCmd(acSysCmdUpdateMeter, 100)
    meterReturn = SysCmd(acSysCmdClearStatus)
    
  'Make look like a report
    xlBudgetSchedule.ActiveSheet.Name = "Budget by Category"
    xlBudgetSchedule.ActiveWindow.Caption = "Budget by Category"
    xlBudgetSchedule.Application.Caption = "Budget Cashflow Schedule"
    xlBudgetSchedule.Application.DisplayFormulaBar = False
    xlBudgetSchedule.ActiveWindow.DisplayFormulas = False
    xlBudgetSchedule.ActiveWindow.DisplayHeadings = False
    xlBudgetSchedule.ActiveWindow.DisplayZeros = False
    
    
    ChartBudgetPaymentsCategory
    xlBudgetSchedule.Visible = True

    
End Sub



Public Function ExcelColumnLetters(nColumnNumber As Integer) 
    'Returns the corresponding Excel column letter notation given an excel column number
    Dim cLetterNotation As String
    
    If nColumnNumber <= 26 Then
        cLetterNotation = Chr(64 + nColumnNumber)
    Else
        cLetterNotation = ExcelColumnLetters(nColumnNumber / 26) & ExcelColumnLetters(nColumnNumber Mod 26)
    End If
    
    ExcelColumnLetters = cLetterNotation
    
End Function

Del.icio.us Del.icio.us | Reddit | Digg Digg | Blinklist BlinkList | Furl Furl Spurl Spurl | Add to Simpy Simpy



Back to Papers and Articles

Last rejuvenated: 9/9/2010 1:34:59 AM        © 2010 Paragon Corporation   All Rights Reserved