Hello,

I am working on a non-profit accounting program - and my last bit was to create a list of year end adjustments to close (zero) income and expense accounts with the balance going to Retained Earnings. What follows is the method I used, but it is somewhat slow... perhaps 2 lines on the General Ledger (GL) per second. I am wondering if there is a faster method?

On my Chart of Accounts (CoA) I have a year-to-date total of debits and credits for each budget area. I use the Filter command to find all debits in the GL, and the same line subtracts all credits found in the GL. The HidStartLYr and HidEndLYr come from a hidden sheet that defines the society's start and end fiscal period. 

dynamic formula in last column of the CoA - [Note: Budget Area is a column in that Table]:
=SUM(FILTER(TableGL[Debit],(TableGL[Budget Area]=[@[Budget Area]])*(TableGL[Date]>=HidStartLYr)*(TableGL[Date]<=HidEndLYr),0))-SUM(FILTER(TableGL[Credit],(TableGL[Budget Area]=[@[Budget Area]])*(TableGL[Date]>=HidStartLYr)*(TableGL[Date]<=HidEndLYr),0))
So for the VBA, I chose to find all Budget Areas (for all rows within the CoA Table) where the account type is "Income" or "Expense", where the Account Status is "Active", and the Total of the account at year end is not zero. The VBA then saves those items in the GL using Global variables defined for saving entries to the GL. The total difference at the end is put to Retained Earnings.

Here is the code if you can make sense of it.
Sub DoYearEnd()
    Dim wks As Worksheet, wkGL
    Set wks = Sheet1    'CoA sheet
    Set wkGL = Sheet5  'GL sheet
    Dim rw As ListRow
    Dim rwGL As ListObject
    Set rwGL = wkGL.ListObjects("TableGL")
    Dim cl As Range
    Dim myType As String, myActive
    Dim myTBal As Double, myTotal
    Dim LastRwGL As Integer
    GLTNo = Application.WorksheetFunction.Max(Range("GLTransNo")) + 1    'use the next available Transaction No for all entries for this Year End Adjustment
    GLIt = "Year End Adjustments"                                                              'set Global variable for Item for all entries in Transaction
    GLDt = Range("HidEndLYr").Value                                                          'set Global variable for Date for all entries in Transaction
    For Each rw In wks.ListObjects("Table18").ListRows                                 'Loop through all rows of Table18 (CoA table. (I just noticed I didn't set this as a ListObject)
        myType = wks.Cells(rw.Range.Row, Range("CATypeCol").Column).Value
        myActive = wks.Cells(rw.Range.Row, Range("CAActiveCol").Column).Value
        If myType = "Income" Or myType = "Expense" And myActive = "Yes" Then      'check for type to be income or expense and account to be active. if so then...
            GLBA = wks.Cells(rw.Range.Row, Range("CAAcctCol").Column).Value          'set that lines Global var. for Budget Area
            myTBal = wks.Cells(rw.Range.Row, Range("CATrialBalCol").Column).Value   'set that lines Global var. for the total year end balance
            If myTBal < 0 Then GLDr = -myTBal: GLCr = Empty                                   'if the balance is negative then it is a credit balance and must be a debit to zero
            If myTBal > 0 Then GLCr = myTBal: GLDr = Empty                                    'if balance is positive then it is a debit balance and must be a credit to zero
            If myTBal = 0 Then GoTo JmpOver                                                            'if balance is zero, then there is no need to zero, so jump the next line
            GoSub SaveYEData                                                                                  'send to SaveYEData Subroutine that writes to Gen Ledger
            End If
JmpOver:
    Next rw                                                                                                          'get next row of CoA
    'Next line formula: After all row entries, get difference  of Debit and Credit totals of GL and write to Retained Earnings
    myTotal = Sheet5.ListObjects("TableGL").TotalsRowRange(Sheet5.ListObjects("TableGL").ListColumns("Debit").Index).Value - _
        Sheet5.ListObjects("TableGL").TotalsRowRange(Sheet5.ListObjects("TableGL").ListColumns("Credit").Index).Value
    If myTotal > 0 Then
        GLDr = myTotal: GLCr = 0
        Else: GLCr = myTotal: GLDr = 0
        End If
        GLBA = "Retained Earnings"
        GoSub SaveYEData
    Set wks = Nothing
    Set wkGL = Nothing
    Set rwGL = Nothing
    Exit Sub
SaveYEData:                                                                                                          'Save to GJ 
    rwGL.ListRows.Add                                                                                             'Add new row
    LastRwGL = rwGL.ListRows.Count + wkGL.Range("GLTNo").Row - 1                       'Get last row (LastRwGL) for use in saving next lines
    If GLTNo <> "" Then Cells(LastRwGL, Range("GLTNo").Column) = GLTNo                'Save Transaction No
    If Not IsEmpty(GLDt) Then Cells(LastRwGL, Range("GLDt").Column) = GLDt           'Save Date
    If GLBA <> "" Then Cells(LastRwGL, Range("GLBA").Column) = GLBA                     'Save Budget Area
    If GLIt <> "" Then Cells(LastRwGL, Range("GLIt").Column) = GLIt                         'Save Item
    If Not IsEmpty(GLDr) Then Cells(LastRwGL, Range("GLDr").Column) = GLDr           'If applicable save Debit amount
    If Not IsEmpty(GLCr) Then Cells(LastRwGL, Range("GLCr").Column) = GLCr            'If applicable save Credit amount
    Return                                                                                                                'Return from subroutine
End Sub
Thanks for any pointers on how to speed this up. I only had about 20 items - but some saves could be much longer if there are 100 or more entries.
Gary J