VBA Code for Auto Payments in Check Register

D

Domenic

Hi everyone!

I have a check register in which I keep track of all my daily
transactions. Some of these transactions include automatic payments and
a deposit that occur on a monthly basis.

Does anyone have a macro that would automatically record these
transactions when they become or have become due?

Thanks, in advance, for any help!
 
J

JE McGimpsey

Domenic said:
I have a check register in which I keep track of all my daily
transactions. Some of these transactions include automatic payments and
a deposit that occur on a monthly basis.

Does anyone have a macro that would automatically record these
transactions when they become or have become due?
Click to expand...

What you're asking requires more information...

Where do you want to store the automatic transactions? Should they be
editable? Are they all due on the same day? What information needs to be
entered?
 
D

Domenic

JE McGimpsey said:
What you're asking requires more information...

Where do you want to store the automatic transactions? Should they be
editable? Are they all due on the same day? What information needs to be
entered?
Click to expand...

I have a spreadsheet where I keep track of cheques issued, debit card
transactions, automatic payments, and deposits. I have the following
columns:

Column A = Date
Column B = Source (Cheque Number, Deposit, Automatic Payment, Automatic
Deposit)
Column C = Payable To/Description
Column D = Debit Amount
Column E = Credit Amount
Column F = Balance

I have a number of transactions that occur monthly but on different
days. For example:

-my home insurance premium is automatically withdrawn from my account on
the 15th of each month
-my Internet service provider automatically deducts an amount from my
account on the 5th day of each month
-a deposit is made to my account on the 27th of each month
etc...

I was hoping that a macro could enter the relevant information (Date,
Source, etc.) on the same spreadsheet for each of these automatic
transactions when they're due or have become due.

So, if I open my spreadsheet on the 20th of a particular month and run
the macro, it would enter the automatic transactions for the 15th
(insurance premium) and the 5th (Internet service provider).

Then, if I ran the macro again on the 30th, it would enter the automatic
transaction for the 27th (automatic deposit), but not the 15th and 5th,
which have already been entered previously using the macro.

I hope this is a lot clearer. Thanks again for any help!
 
D

Domenic

Hi everyone!

I take it the reason no one has come forward to help with this is
because no one here has an existing macro that comes close to what I'm
looking for, and writing one would be somewhat complex and very time
consuming. If this is the case, I can definitely understand. Thanks
all the same!
 
J

JE McGimpsey

Domenic said:
I take it the reason no one has come forward to help with this is
because no one here has an existing macro that comes close to what I'm
looking for, and writing one would be somewhat complex and very time
consuming. If this is the case, I can definitely understand. Thanks
all the same!
Click to expand...

Thinking about it, it's not all that difficult, but it takes some
setting up. The following is a quick and dirty attempt. It assumes that
you open your workbook at least once per month.

One way would be to put, on sheet "Auto", the following headers:

A1: Description
B1: Source
C1: Day of Month
D1: Debit Amount
E1: Credit Amount
F1: 1 July 2004

Enter your auto data.

Then put this code in your ThisWorkbook code module:

Private Sub Workbook_Open()
Auto_Update
End Sub

and put something like this in a regular code module:

Public Sub UpdateAutoItems()
Dim nLastCol As Long
With Sheets("Auto")
With .Cells(1, .Columns.Count)
If Not IsEmpty(.Value) Then
MsgBox "Auto Data range Full"
Exit Sub
Else
If IsEmpty(.Offset(0, -1).Value) Then
nLastCol = .End(xlToLeft).Column
Else
nLastCol = .Column
End If
End If
End With
If .Cells(1, nLastCol).Value <> DateSerial( _
Year(Date), Month(Date), 1) Then
EnterItems nLastCol, 32
nLastCol = nLastCol + 1
.Cells(1, nLastCol).Value = DateSerial( _
Year(Date), Month(Date), 1)
End If
EnterItems nLastCol, Day(Date)
End With
End Sub

Public Sub EnterItems(nCol, nAsOfDate As Long)
Dim vEntry As Variant
Dim rCell As Range
Dim dEntryDate As Double

With Sheets("Auto")
For Each rCell In .Cells(2, nCol).Resize( _
.Cells(.Rows.Count, 1).End(xlUp).Row - 1, 1)
If IsEmpty(rCell.Value) Then
If .Cells(rCell.Row, 3).Value <= nAsOfDate Then
dEntryDate = CDate(.Cells(1, nCol) + _
.Cells(rCell.Row, 3) - 1)
ReDim vEntry(1 To 6)
With .Cells(rCell.Row, 1).Resize(1, 5)
vEntry(1) = Format(dEntryDate, "dd mmm yyyy")
vEntry(2) = .Item(2)
vEntry(3) = .Item(1)
vEntry(4) = .Item(4)
vEntry(5) = .Item(5)
End With
With Sheets("Sheet1")
With .Cells(.Rows.Count, _
1).End(xlUp).Offset(1, 0)
.Resize(1, 5).Value = vEntry
.Offset(0, 5).FormulaR1C1 = _
"=R[-1]c[]-r[]c[-2]+r[]c[-1]"
End With
End With
rCell.Value = "X"
End If
End If
Next rCell
End With
End Sub


The sub will then keep track of entered auto values for 251 months (If
you're still using it after nearly 21 years, the sub tells you the data
range is full).

NOTE: This has been only lightly tested.
 
D

Domenic

Hi JE,

First let me say that I can't thank you enough for taking the time to
write this code. It obviously took some time, and for that I'm truly
grateful.

I've tried it, and there are a couple of issues I hope are minor ones.
They are the following:

1) When I open the file (after putting the codes in their appropriate
places), I get the following error message:

Compile error: Sub or Function not defined

When I click OK, this part of the code, which I placed in ThisWorkbook,
is highlighted in yellow:

Private Sub Workbook_Open()

2) I would prefer the date format to be "mmmm d, yyyy". I've tried
changing it in the code but it doesn't change the format. I tried
changing it here:

vEntry(1) = Format(dEntryDate, "mmmm d, yyyy")

One other matter which is my fault and I apologize for this. I forgot
that my columns for my spreadsheet start in Column B and not Column A.
I have the width for Column A set to 0.5 and use it so that I can see my
borders -- basically for aesthetic reasons.

Would it be too much trouble to adjust the code to take the correct
columns into account? Otherwise I can live with it and change my
spreadsheet to suit your code.

Thanks again, JE!


JE McGimpsey said:
Domenic said:
I take it the reason no one has come forward to help with this is
because no one here has an existing macro that comes close to what I'm
looking for, and writing one would be somewhat complex and very time
consuming. If this is the case, I can definitely understand. Thanks
all the same!
Click to expand...

Thinking about it, it's not all that difficult, but it takes some
setting up. The following is a quick and dirty attempt. It assumes that
you open your workbook at least once per month.

One way would be to put, on sheet "Auto", the following headers:

A1: Description
B1: Source
C1: Day of Month
D1: Debit Amount
E1: Credit Amount
F1: 1 July 2004

Enter your auto data.

Then put this code in your ThisWorkbook code module:

Private Sub Workbook_Open()
Auto_Update
End Sub

and put something like this in a regular code module:

Public Sub UpdateAutoItems()
Dim nLastCol As Long
With Sheets("Auto")
With .Cells(1, .Columns.Count)
If Not IsEmpty(.Value) Then
MsgBox "Auto Data range Full"
Exit Sub
Else
If IsEmpty(.Offset(0, -1).Value) Then
nLastCol = .End(xlToLeft).Column
Else
nLastCol = .Column
End If
End If
End With
If .Cells(1, nLastCol).Value <> DateSerial( _
Year(Date), Month(Date), 1) Then
EnterItems nLastCol, 32
nLastCol = nLastCol + 1
.Cells(1, nLastCol).Value = DateSerial( _
Year(Date), Month(Date), 1)
End If
EnterItems nLastCol, Day(Date)
End With
End Sub

Public Sub EnterItems(nCol, nAsOfDate As Long)
Dim vEntry As Variant
Dim rCell As Range
Dim dEntryDate As Double

With Sheets("Auto")
For Each rCell In .Cells(2, nCol).Resize( _
.Cells(.Rows.Count, 1).End(xlUp).Row - 1, 1)
If IsEmpty(rCell.Value) Then
If .Cells(rCell.Row, 3).Value <= nAsOfDate Then
dEntryDate = CDate(.Cells(1, nCol) + _
.Cells(rCell.Row, 3) - 1)
ReDim vEntry(1 To 6)
With .Cells(rCell.Row, 1).Resize(1, 5)
vEntry(1) = Format(dEntryDate, "dd mmm yyyy")
vEntry(2) = .Item(2)
vEntry(3) = .Item(1)
vEntry(4) = .Item(4)
vEntry(5) = .Item(5)
End With
With Sheets("Sheet1")
With .Cells(.Rows.Count, _
1).End(xlUp).Offset(1, 0)
.Resize(1, 5).Value = vEntry
.Offset(0, 5).FormulaR1C1 = _
"=R[-1]c[]-r[]c[-2]+r[]c[-1]"
End With
End With
rCell.Value = "X"
End If
End If
Next rCell
End With
End Sub


The sub will then keep track of entered auto values for 251 months (If
you're still using it after nearly 21 years, the sub tells you the data
range is full).

NOTE: This has been only lightly tested.
Click to expand...
 
J

JE McGimpsey

Comments in-line:

1) When I open the file (after putting the codes in their appropriate
places), I get the following error message:

Compile error: Sub or Function not defined

When I click OK, this part of the code, which I placed in ThisWorkbook,
is highlighted in yellow:

Private Sub Workbook_Open()
Click to expand...

Did you paste the code into your ThisWorkbook module? Occasionally I've
seen problems where a stray character has gotten into that a line. Try
deleting any spaces before the "Private" and any after the "_Open()"
2) I would prefer the date format to be "mmmm d, yyyy". I've tried
changing it in the code but it doesn't change the format. I tried
changing it here:

vEntry(1) = Format(dEntryDate, "mmmm d, yyyy")
Click to expand...

Format() doesn't affect how the date is displayed - that's controlled by
the .Numberformat property. You can manually set this by selecting the
entire date column and formatting it to the date format you want.
One other matter which is my fault and I apologize for this. I forgot
that my columns for my spreadsheet start in Column B and not Column A.
I have the width for Column A set to 0.5 and use it so that I can see my
borders -- basically for aesthetic reasons.
Click to expand...

Just change

With .Cells(.Rows.Count, _
1).End(xlUp).Offset(1, 0)

to

With .Cells(.Rows.Count, _
2).End(xlUp).Offset(1, 0)
 
D

Domenic

Hi JE,

JE McGimpsey said:
Did you paste the code into your ThisWorkbook module? Occasionally I've
seen problems where a stray character has gotten into that a line. Try
deleting any spaces before the "Private" and any after the "_Open()"
Click to expand...

Yes, there were spaces before and after. Although, after removing them,
I still get the same error message after opening the file.

Compile Error: Sub or Function not defined

Private Sub Workbook_Open() ---> highlighted in yellow
Auto_Update --> highlighted

I've ensured that I pasted the code into "ThisWorkbook" code module. If
I look at the title of the window where the code is pasted it says,
"Sample Bank Book.xls - ThisWorkbook (Code)".

I got there by double clicking on "ThisWorkbook", listed in the
Project's window to the left of the code.

Any other ideas as to why this is still happening? Thanks again for
your help!
 
J

JE McGimpsey

Domenic said:
Yes, there were spaces before and after. Although, after removing them,
I still get the same error message after opening the file.

Compile Error: Sub or Function not defined

Private Sub Workbook_Open() ---> highlighted in yellow
Auto_Update --> highlighted
Click to expand...

Oops. Auto_Update should be the name of the update macro (at some point
after I pasted the Workbook_Open code in, I changed the update macro's
name). So the ThisWorkbook Workbook_Open code should read:

Private Sub Workbook_Open()
UpdateAutoitems
End Sub
 
D

Domenic

JE McGimpsey said:
Oops. Auto_Update should be the name of the update macro (at some point
after I pasted the Workbook_Open code in, I changed the update macro's
name). So the ThisWorkbook Workbook_Open code should read:

Private Sub Workbook_Open()
UpdateAutoitems
End Sub
Click to expand...

Yep! That did it! It now works beautifully!

My automatic transactions are now easily updated, and the icing on the
cake (which I hadn't thought of, so thank you) is that my bank book is
automatically updated whenever I open the file. That's great!

JE, again, I can't thank you enough for taking the time to help me with
this. I really appreciate it!

Cheers!
 
Top