Code:
Option Compare Database
Option Explicit
Public Function SplitData()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim ref As String
Dim lineId As Long
Dim sales As String
Dim customer As String
Dim startDt As Date
Dim endDt As Date
Dim priCon As String
Dim brFam As String
Dim prdPlat As String
Dim prdType As String
Dim prdName As String
Dim units As String
Dim amount As Currency
Dim conMonth As String
Dim custConDt As Date
Dim amtCur As String
Dim navID As String
Dim vat As String
Dim InvoiceNo As String 'InvoiceNum
'Define Instalments information for 2nd dataset loop once date split is in dest Table
Dim NumOfInstalments As String
Dim InstallmentPostingDate As String
Dim Installment1 As Currency
Dim InstalmentDD1 As Date
Dim wStartDt As Date
Dim wEndDt As Date
Dim nStartDt As Date
Dim nEndDt As Date
Dim nAmount As Currency
Dim lastOne As Boolean
Dim totDays As Long
Dim monDays As Long
Dim monAmt As Currency
Dim runAmt As Currency
Dim strSQL As String
' Open up query in recordset
Set db = CurrentDb
Set rst = db.OpenRecordset("qrySourceTable", dbOpenDynaset) 'enter your query name
' Loop through recordset
rst.MoveFirst
Do While Not rst.EOF
' Capture record values
ref = rst!Reference
lineId = rst![Line ID]
sales = rst![Sales Person]
customer = rst!customer
startDt = rst![Start Date]
endDt = rst![End Date]
priCon = rst![Primary Contact]
brFam = rst![Brand Family]
prdPlat = rst![Product Platform]
prdType = rst![Product Type]
prdName = rst![Product Name]
units = rst![Unit of Measure]
amount = rst!amount
conMonth = rst![Contract Month]
custConDt = rst![Customer Contract Date]
amtCur = rst![Amount Currency]
navID = rst![Navision ID]
vat = rst![VAT Rate]
' InvoiceNum = rst![Invoice Number]
If IsNull(rst![Invoice Number]) Then
InvoiceNo = vbNullString
Else
InvoiceNo = rst![Invoice Number]
End If
If IsNull(rst![Number of Installment Invoices]) Then
NumOfInstalments = vbNullString
Else
NumOfInstalments = rst![Number of Installment Invoices]
End If
InstallmentPostingDate = rst![Installment Posting Date]
Installment1 = rst![Instalment 1]
InstalmentDD1 = rst![Instalment 1 Due Date]
' Initialize counter
lastOne = False
wStartDt = startDt
wEndDt = EOMDate(startDt)
runAmt = 0
' Capture total number of days
totDays = endDt - startDt + 1
' Loop through records
Do
' Check to see if end date is after end of month, and set dates
If endDt > wEndDt Then
nStartDt = wStartDt
nEndDt = wEndDt
Else
nStartDt = wStartDt
nEndDt = endDt
lastOne = True
End If
' Calculate monthly days & monthly amount
monDays = nEndDt - nStartDt + 1
' Calculate monthly amount and running amount
If lastOne Then
nAmount = amount - runAmt
Else
nAmount = Round(amount * monDays / totDays, 2)
runAmt = runAmt + nAmount
End If
' Build SQL query to insert new record
strSQL = "INSERT INTO DestTable ( Reference, [Line ID], [Sales Person], Customer, [Start Date], [End Date], [Primary Contact], [Brand Family], [Product Platform], "
strSQL = strSQL & "[Product Type], [Product Name], [Unit of Measure], Amount, [Contract Month], [Customer Contract Date], [Amount Currency], [Navision ID],[VAT Rate],[Invoice Number],[Number of Installment Invoices],[Installment Posting Date],[Instalment 1],[Instalment 1 Due Date]) "
strSQL = strSQL & "VALUES ('" & ref & "', " & lineId & ", '" & sales & "', '" & customer & "', #" & Format(nStartDt, "dd-mmm-yyyy") & "#, #" & Format(nEndDt, "dd-mmm-yyyy") & "#, '"
strSQL = strSQL & priCon & "', '" & brFam & "', '" & prdPlat & "', '" & prdType & "', '" & prdName & "', '" & units & "', " & nAmount & ", '"
strSQL = strSQL & conMonth & "', #" & Format(custConDt, "dd-mmm-yyyy") & "#, '" & amtCur & "', '" & navID & "', '" & vat & "', '" & InvoiceNo & "', '" & NumOfInstalments & "', '" & InstallmentPostingDate & "', '" & Installment1 & "', '" & InstalmentDD1 & "')"
' Run SQL
'MsgBox strSQL
' DoCmd.SetWarnings False
' DoCmd.RunSQL strSQL
' DoCmd.SetWarnings True
db.Execute strSQL, dbFailOnError
' Increment dates for next round
wStartDt = BOMDate(wEndDt + 1)
wEndDt = EOMDate(wStartDt)
Loop Until lastOne = True
' Move to next record
rst.MoveNext
Loop
' Clean up
rst.Close ' Close recordset
Set rst = Nothing
Set db = Nothing
MsgBox "Done"
End Function