Blogger BlogNet61187

In this example I show how to create a table of similar data that may only have a date in difference. For example, you want to evaluate how your cash will flow and you have a table of expenditures. You know that you have regular payments for payroll, loans, taxes etc. that you want to put into your transaction data table without having to key in every record when maybe only the date is different. An example would be, you have twelve tax payments, all the same but in different months.

This example demonstrates using an array and SQL statements to create the similar records. It also has a function to replace records if you want to change the amount value and update the data table. The replace function assumes that the description and date are the same and replaces every occurrence of the existing record with the latest amount value. For safekeeping the replace function makes a copy of the data table before executing.

This example requires a form, a module and a three tables to support it.

Create the following Module and name it.

Make sure you set the references to include the MS DAO 3.6 Library. Cut and paste the following code.

Option Compare Database

Option Explicit

Public misql As String, Midb As Database, MiRec As DAO.Recordset, MiRec2 As DAO.Recordset

Public Function GetMiSQL()

Set Midb = CurrentDb()

Set MiRec = Midb.OpenRecordset(misql, dbOpenDynaset)

End Function

Public Function GetMiSQL2()

Set Midb = CurrentDb()

Set MiRec2 = Midb.OpenRecordset(misql, dbOpenDynaset)

End Function

Public Function PutMiSQL()

Dim Midb As Database ', MiRec As DAO.Recordset

Set Midb = CurrentDb()

Midb.Execute misql

End Function

Table 1. Cash

Amount currency

Cdate date/time

Desc text

Once you have created this table close and save it as Cash. Make a copy of it and name it CashBac. It will be used to make a copy of your data before you do a replace.

Table 2. Repeats

Item text

Amount currency

Occr number

DOM number

Set both of the number items properties Integer. Close and save the table as Repeats.

Create Form "Transactions"

Use table "Repeats" as the datasource

Put a Form header and footer on the form

Place all the fields from the table on the form.

Place all the field labels in the form header above their respective field placed in a single row in the detail section of the form. Format the form as a Continuous Form.

Place two buttons in the form footer and name them BT1 and BT2.

Change the caption for BT1 to Create and for BT2 to Replace.

Place the following code in the form. Open the form in design view, then click view code from the menu tool bar. This opens the VBA editor. You can just cut and paste from this file to avoid typing.

Cut Here.

'************************

Public Function DoRept()

Dim ItemVal(12, 4) As Variant

Dim Recnt As Integer, RDate As Date, xtimes As Integer

misql = "SELECT Repeats.Item, Repeats.Amount, Repeats.Occr, repeats.dom FROM Repeats;"

GetMiSQL

MiRec.MoveLast

Recnt = MiRec.RecordCount

MiRec.MoveFirst

For X = 1 To Recnt

ItemVal(X, 1) = MiRec(0)

ItemVal(X, 2) = MiRec(1)

ItemVal(X, 3) = MiRec(2)

ItemVal(X, 4) = MiRec(3)

xtimes = MiRec(2)

'Debug.Print ItemVal(x, 1) & " " & ItemVal(x, 2) & " " & ItemVal(x, 3) & " " & ItemVal(x, 4)

For z = 1 To xtimes

RDate = z & "/" & ItemVal(X, 4) & "/08"

misql = "INSERT INTO Cash ( [Desc], Amount, [Cdate]) SELECT '" & ItemVal(X, 1) & "' AS x1, " & ItemVal(X, 2) & " AS x2, #" & RDate & "# AS x3;"

PutMiSQL

'Debug.Print misql

Next

MiRec.MoveNext

Next

getout:

MiRec.Close

End Function

'*********************

Private Sub BT1_Click()

DoRept

End Sub

'***********************

Public Function DoReplace()

Dim ItemVal(12, 4) As Variant

Dim Recnt As Integer, RDate As Date, xtimes As Integer

misql = "SELECT Repeats.Item, Repeats.Amount, Repeats.Occr, repeats.dom FROM Repeats;"

GetMiSQL

misql = " DELETE CashBac.* FROM CashBac;"

PutMiSQL

misql = "INSERT INTO CashBac SELECT cash.* FROM cash;"

PutMiSQL

MiRec.MoveLast

Recnt = MiRec.RecordCount

MiRec.MoveFirst

For X = 1 To Recnt

ItemVal(X, 1) = MiRec(0)

ItemVal(X, 2) = MiRec(1)

ItemVal(X, 3) = MiRec(2)

ItemVal(X, 4) = MiRec(3)

xtimes = MiRec(2)

'Debug.Print ItemVal(x, 1) & " " & ItemVal(x, 2) & " " & ItemVal(x, 3) & " " & ItemVal(x, 4)

For z = 1 To xtimes

'change the 08 value in the next line to the current year or set a value on the form and change it with a 'variable.

RDate = z & "/" & ItemVal(X, 4) & "/08"

misql = "UPDATE Cash SET Cash.Amount =" & ItemVal(X, 2) & " WHERE Cash.Desc= '" & ItemVal(X, 1) & "' AND Cash.Cdate= #" & RDate & "#;"

PutMiSQL

'Debug.Print misql

Next

MiRec.MoveNext

Next

MiRec.Close

End Function

'***********************

Private Sub BT2_Click()

DoReplace

End Sub

'***********************

Cut Here.

This should do it. As always, there are many different ways to accomplish something similar to this. This works for me and saves a lot of time when I want to run several what if's with my cash flow analysis. This example was created with Access 2002 and runs as listed on my system. This is a free example and I can't support it or make changes with out compensation so please don't ask.

This example and many others can be found on our website at www.biomationsystems.com. All of the examples found there are accompanied by a functioning Access database file.

Contact Jon Watson at jonw@biomationsystems.com For more help with Access visit our Web sites atwww.biomationsystems.com | http://www.accessdatabasehelp.com