Automatic copy of rows from either of two sheets to a thirdClosed

Question

Greetings,

I have taken over as Treasurer for a small non-profit organization and have inherited a rudimentary spreadsheet system for tracking their financial transactions.  There is a lot of copying and pasting required currently, and I'd like to automate this to 1) make it easier and 2) minimize mistakes.  Later on, I'll work on overhauling the system, but for this first fiscal year, I need to keep things pretty constant.

Here's what I have to work with:
   SHEET 1: DEPOSITS   
   Columns:  Date [A], Deposit Description [B], (a bunch of subcategory columns), Deposit Total [M]

   SHEET 2: EXPENSES
   Columns:  Date [A], Expense Description [B], (a bunch of subcategory columns), Line Total [P]

   SHEET 3:  REGISTER
   Columns:  Date [A], Description [B], Amount [C], Running Balance [D]

What I want to have happen is this: when I enter a new row in either the DEPOSITS sheet or the EXPENSES sheet, the appropriate data from that row is also entered in the REGISTER sheet (as a minus transaction, in the case of the EXPENSES).  This will essentially give me an automatic check register.  I understand that the dates may be off if I enter in all of the deposits and then all the expenses for a given time frame, but I have no problem sorting the data manually as needed if an automated way to keep it sorted cannot be devised.  

Full disclosure: while my Excel skills are decent, my VB skills are, well, basic.  So I may need clarification on your response.

I understand that I'd be better off just moving to something like QuickBooks, but that is another battle for another time.  ;)

I appreciate any advice and suggestions offered.  Thank you!

vcoolio · Answer

Hello Melrowgo,

If I have understood your query correctly, I think that the following code may do the task for you:-

Sub Summarise()

Dim lr As Long
    Dim ws As Worksheet, ws1 As Worksheet, sh As Worksheet

Set ws = Sheet1
Set ws1 = Sheet2
Set sh = Sheet3

Application.ScreenUpdating = False

sh.UsedRange.Offset(1).ClearContents

lr = ws.Range("A" & Rows.Count).End(xlUp).Row
   If lr > 1 Then
      Union(ws.Range("A2:B" & lr), ws.Range("M2:N" & lr)).Copy
        sh.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
End If

lr = ws1.Range("A" & Rows.Count).End(xlUp).Row
   If lr > 1 Then
     Union(ws1.Range("A2:B" & lr), ws1.Range("P2:Q" & lr)).Copy
       sh.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
End If

lr = sh.Range("A" & Rows.Count).End(xlUp).Row
sh.[E2] = "=C2"
sh.Range("E3:E" & lr) = "=$C3+$E2"

For i = 2 To lr
    If sh.Cells(i, 4).Value = "E" Then
       sh.Cells(i, 3) = "-" & sh.Cells(i, 3).Value
          If Left(sh.Cells(i, 5), 1) = "-" Then
             sh.Cells(i, 5).Font.ColorIndex = 3
                Else: sh.Cells(i, 5).Font.ColorIndex = 1
          End If
    End If
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Following is the link to a little sample that I have prepared for you from my understanding of your opening post:-

https://www.dropbox.com/s/uxvbzuqcwm4db34/Deposits%26Expenses%20Summary%28Melrowgo%29.xlsm?dl=0

Click on the "Summarise" button to see it all work.

You'll notice in the sample that I have added a "Type" column in each sheet ("D" for Deposit and "E" for Expense) just to make identifying the type of expense in the "Register" sheet easier for the code to manipulate.

In the "Register" sheet, should the Running Balance go into the "red" then the font will change to red for simpler identification of the fact.

The "Register" sheet will refresh each time that you click on the button.

Play with the sample by adding/deleting entries as you wish so that you can see how the code copes with the changes but test the code in a copy of your work book first. 

I hope that this helps.

Cheerio,
vcoolio.

P.S. If you want to sort the "Register" by date, just add the following line of code:-


sh.Range("A2", sh.Range("D" & sh.Rows.Count).End(xlUp)).Sort sh.[A2], 1

directly after line 25 in the code above.

Automatic copy of rows from either of two sheets to a third

1 reply

Similar discussions

Subscribe To Our Newsletter!