Help needed in modifying Function

[Alex Motilal]

Hi everybody.
I have developed a database for a Ginning Factory. The cotton seed generated is auctioned and contracts are raised. When the seed is ready the buyer is intimated. The buyer has to pay and lift the seed within 5 days if the contracted quantity is less than 2000 quintals. For 2000 qtls and more he has to make payment within 7 days. If the buyer delays payment more than the stipulated date (ie. More than 5 or 7 days), then carrying charges are levied. For the first 15 days delay, it is 2% on the seed value per month and for the second 15 days 2.25% per month on seed value. After 30 days it is 3% per month on monthly rest basis.
I have created a module to calculate the total carrying charges, which will be included in the final invoice. If the buyer needs details of the carrying charges, at present details are given in an Excel sheet .
I request somebody to go through the module and see if it is possible to generate the details as an Access Report as in the Excel format Below?


Module:
Option Compare Database
Option Explicit

Public Function CarChagWithRateChange(ContQty As Double, LotVal As Double, IntimDate As Date, PymtDate As Date) As Double



Dim LastDateOfDel As Date
Dim Days As Integer
Dim CCrateFor1stSlab As Single
Dim CCrateFor2ndSlab As Single
Dim CCrateFor3rdSlab As Single

LastDateOfDel = IIf(ContQty >= 2000, IntimDate + 7, IntimDate + 5)

Days = IIf((PymtDate - LastDateOfDel) <= 0, 0, (PymtDate - LastDateOfDel))

CCrateFor1stSlab = DLookup("[CC1stSlabRate%]", "tblCCrates", "[DateFrom]<= #" & LastDateOfDel & "# And Nz([DateTo],#12/31/9999#)> #" & LastDateOfDel & "#")

CCrateFor2ndSlab = DLookup("[CC2ndSlabRate%]", "tblCCrates", "[DateFrom]<= #" & LastDateOfDel & "# And Nz([DateTo],#12/31/9999#)> #" & LastDateOfDel & "#")

CCrateFor3rdSlab = DLookup("[CC3rdSlabRate%]", "tblCCrates", "[DateFrom]<= #" & LastDateOfDel & "# And Nz([DateTo],#12/31/9999#)> #" & LastDateOfDel & "#")

Dim DaysA As Integer
Dim DaysB As Integer
Dim DaysC As Integer
Dim DaysD As Integer
Dim DaysE As Integer
Dim DaysF As Integer
Dim DaysG As Integer
Dim DaysH As Integer

Dim CCa As Double
Dim CCb As Double
Dim CCc As Double
Dim CCd As Double
Dim CCe As Double
Dim CCf As Double
Dim CCg As Double
Dim CCh As Double

Dim First30daysVal As Double
Dim Second30daysVal As Double
Dim Third30daysVal As Double
Dim Forth30daysVal As Double
Dim Fifth30daysVal As Double
Dim Sixth30daysVal As Double

'Days evaluation
DaysA = IIf(Days >= 15, 15, Days)
DaysB = IIf((Days - DaysA) >= 15, 15, (Days - DaysA))
DaysC = IIf((Days - (DaysA + DaysB)) >= 30, 30, Days - (DaysA + DaysB))
DaysD = IIf((Days - (DaysA + DaysB + DaysC)) >= 30, 30, Days - (DaysA + DaysB + DaysC))
DaysE = IIf((Days - (DaysA + DaysB + DaysC + DaysD)) >= 30, 30, Days - (DaysA + DaysB + DaysC + DaysD))
DaysF = IIf((Days - (DaysA + DaysB + DaysC + DaysD + DaysE)) >= 30, 30, Days - (DaysA + DaysB + DaysC + DaysD + DaysE))
DaysG = IIf((Days - (DaysA + DaysB + DaysC + DaysD + DaysE + DaysF)) >= 30, 30, Days - (DaysA + DaysB + DaysC + DaysD + DaysE + DaysF))
DaysH = IIf((Days - (DaysA + DaysB + DaysC + DaysD + DaysE + DaysF + DaysG)) >= 30, 30, Days - (DaysA + DaysB + DaysC + DaysD + DaysE + DaysF + DaysG))

'First 15 days CC evaluation
CCa = (LotVal * (CCrateFor1stSlab / 100) / 30) * DaysA

'Second 15 days CC evaluation
CCb = (LotVal * (CCrateFor2ndSlab / 100) / 30) * DaysB

'First 30 days value and CC evaluation
First30daysVal = LotVal + CCa + CCb
CCc = (First30daysVal * (CCrateFor3rdSlab / 100) / 30) * DaysC

'Second 30 days value and CC evaluation
Second30daysVal = First30daysVal + CCc
CCd = (Second30daysVal * (CCrateFor3rdSlab / 100) / 30) * DaysD

'Third 30 days value and CC evaluation
Third30daysVal = Second30daysVal + CCd
CCe = (Third30daysVal * (CCrateFor3rdSlab / 100) / 30) * DaysE

'Forth 30 days value and CC evaluation
Forth30daysVal = Third30daysVal + CCe
CCf = (Forth30daysVal * (CCrateFor3rdSlab / 100) / 30) * DaysF

'Fifth 30 days value and CC evaluation
Fifth30daysVal = Forth30daysVal + CCf
CCg = (Fifth30daysVal * (CCrateFor3rdSlab / 100) / 30) * DaysG

'Sixth 30 days value and CC evaluation
Sixth30daysVal = Fifth30daysVal + CCg
CCh = (Sixth30daysVal * (CCrateFor3rdSlab / 100) / 30) * DaysH

'Total CC
CarChagWithRateChange = CCa + CCb + CCc + CCd + CCe + CCf + CCg + CCh

End Function

-------------------------------------------------------------------------------------

CC Excel Worksheet
1st 15 days CC% : 2.00
2nd 15 days CC% : 2.25
Subsequent CC% : 3.00
Contract No : 1
Contract Date : 1-Nov-10
Contract Qty : 2000
Contract Rate : 1700.00
Intimation Date : 10-Nov-10
Payment Date : 26-Jan-11
DC Qty : 100.0
DC Value : 170000
CC Workings:
Delivery on or Before : 17-Nov-10
CC Days : 70
CC on Value Days CC
1st Slab CC @2% : 170000 15 1700
2nd Slab CC @2.25% : 170000 15 1913
3rd Slab CC @3% : 173613 30 5208
4th Slab CC @3% : 178821 10 1788

Total: 10609
----------------------------------------------------

With Thanks,
Alex

[ssanfu]

Alex,

Well, I got the report to work, kind of. I don't really like it because I used a temp table to save the calculated data from the form. But the code returns the same numbers as your example.

You might have a couple of problems..... the MDB is A2K... i don't have access to A2K7. And it requires a reference set to DAO.

Hopfully it gets you moving in the right direction.

[Alex Motilal]

Dear ssanfu,
Your solution works perfectly. I posted this thread nearly a week ago and I am sure you should have taken lots of pain to solve. I thank you very much. I will incorporate this in the actual Database and let you know the result.
In the module I have stopped evaluating to the maximum of 210 days delay, since more than 90 days delay is very rare. In case if delay exceeds more than 210 days, is it possible to evaluate with a single syntax by simplifying the long evaluation of days in the module?
Alex

[Alex Motilal]

Dear ssanfu,
I incorporated the solution in my database and it works fine.
Thanks
Alex

[ssanfu]

<snip> In case if delay exceeds more than 210 days, is it possible to evaluate with a single syntax by simplifying the long evaluation of days in the module?

See attached zip..

I shortened your code, mostly by using an array. The form uses a subform to display the CC data. I envision using a report/subreport to to generate the final invoice. Note that you need to add this line at the top of the code page:

Option Base 1


The is the code I ended up with that will calc any number of 30 day periods:

Option Compare Database
Option Explicit
Option Base 1    ' <<<< Note

Private Sub Calc2_Click()

   Const DaysPerMonth As Integer = 30

   Dim D As DAO.Database
   Dim R As DAO.Recordset
   Dim sSQL As String

   Dim C_num As Long   'contract number

   Dim pContQty As Double
   Dim pLotVal As Double
   Dim pIntimDate As Date
   Dim pPymtDate As Date

   Dim sString As String

   Dim LastDateOfDel As Date
   Dim Days As Integer
   '   Dim tmpDays As Integer
   Dim CCrateFor1stSlab As Single
   Dim CCrateFor2ndSlab As Single
   Dim CCrateFor3rdSlab As Single
   Dim Result As Single
   Dim sngTotal As Single
   Dim DaysVal As Single
   Dim CC1Rate As Single
   Dim CC2Rate As Single
   Dim CC3Rate As Single

   Dim i As Integer
   Dim NumDays As Integer

   Dim ArrayUB As Integer
   '---------------------------

   If Me.NewRecord Then
      MsgBox "New record - no data"
      Exit Sub
   End If

   'get data
   pContQty = Me.ContractQty
   pLotVal = Me.DC_Value
   pIntimDate = Me.IntimationDate
   pPymtDate = Nz(Me.PaymentDate, #12/31/9999#)
   C_num = Me.ContractNum

   LastDateOfDel = IIf(pContQty >= 2000, pIntimDate + 7, pIntimDate + 5)
   Me.DeliveryDate = LastDateOfDel

   Days = IIf(DateDiff("d", LastDateOfDel, pPymtDate) < 1, 0, DateDiff("d", LastDateOfDel, pPymtDate))
   Me.CC_Days = Days

   ArrayUB = (Days \ DaysPerMonth) + 2
   ReDim sngArray(ArrayUB, 4) As Variant

   Set D = CurrentDb

   '----------------------------------
   'get CC rates from table
   sSQL = "SELECT TOP 1 tblCCrates.CC1, tblCCrates.CC2, tblCCrates.CC3, tblCCrates.DateFrom, tblCCrates.DateTo"
   sSQL = sSQL & " FROM tblCCrates"
   sSQL = sSQL & " WHERE tblCCrates.DateFrom <= #" & LastDateOfDel & "# AND tblCCrates.DateTo >= #" & LastDateOfDel & "#"
   sSQL = sSQL & " ORDER BY tblCCrates.DateFrom DESC;"
   Set R = D.OpenRecordset(sSQL)
   If Not (R.BOF And R.EOF) Then
      R.MoveLast
      R.MoveFirst
      CCrateFor1stSlab = R!CC1
      CCrateFor2ndSlab = R!CC2
      CCrateFor3rdSlab = R!CC3
      R.Close
      Set R = Nothing
   Else
      R.Close
      Set R = Nothing
      Set D = Nothing
      Exit Sub
   End If
   '----------------------------------

   Me.CC_Rate1 = CCrateFor1stSlab
   Me.CC_Rate2 = CCrateFor2ndSlab
   Me.CC_Rate3 = CCrateFor3rdSlab

   'calc percentages
   CC1Rate = (CCrateFor1stSlab / 100) / DaysPerMonth
   CC2Rate = (CCrateFor2ndSlab / 100) / DaysPerMonth
   CC3Rate = (CCrateFor3rdSlab / 100) / DaysPerMonth

   'First 15 days CC evaluation
   NumDays = IIf(Days >= 15, 15, Days)
   Result = pLotVal * CC1Rate * NumDays
   sngArray(1, 1) = "1st Slab CC @" & CStr(CCrateFor1stSlab) & "% :"
   sngArray(1, 2) = pLotVal
   sngArray(1, 3) = NumDays
   sngArray(1, 4) = Result
   sngTotal = Result
   Days = Days - NumDays

   'Second 15 days CC evaluation
   NumDays = IIf(Days >= 15, 15, Days)
   Result = pLotVal * CC2Rate * NumDays
   sngArray(2, 1) = "2nd Slab CC @" & CStr(CCrateFor2ndSlab) & "% :"
   sngArray(2, 2) = pLotVal
   sngArray(2, 3) = NumDays
   sngArray(2, 4) = Result
   sngTotal = sngTotal + Result
   Days = Days - NumDays

   'subsequent each 30 days value and CC evaluation
   For i = 3 To ArrayUB
      NumDays = IIf(Days >= DaysPerMonth, DaysPerMonth, Days)
      DaysVal = IIf(i = 3, pLotVal + sngTotal, DaysVal + Result)
      Result = DaysVal * CC3Rate * NumDays
      '      sngArray(i) = Result
      Select Case i
      Case 3
         sString = "3rd"
      Case Else
         sString = CStr(i) & "th"
      End Select
      sngArray(i, 1) = sString & " Slab CC @" & CStr(CCrateFor3rdSlab) & "% :"
      sngArray(i, 2) = Round(DaysVal + 0.5, 0)
      sngArray(i, 3) = NumDays
      sngArray(i, 4) = Result

      sngTotal = sngTotal + Result
      Days = Days - NumDays
   Next

   '-------------------------------
   'this is where you would update a (temp) table for the report.
   'I was thinking of a form/subform display.
   '        1   ----->   many
   '   Contracts----->tblDetails

   D.Execute "DELETE * FROM tblDetails", dbFailOnError

   For i = 1 To ArrayUB
      sSQL = "INSERT INTO tblDetails (ContractNumberFK, LabelSlab, Slab, Days, Amt, theTotal, theOrder)"
      sSQL = sSQL & " VALUES (" & C_num & ", '" & sngArray(i, 1) & "', " & sngArray(i, 2) & ", " & sngArray(i, 3) & ", " & sngArray(i, 4) & ", " & sngTotal & ", " & i & ");"
      '      Debug.Print sSQL
      D.Execute sSQL, dbFailOnError
   Next
   '-------------------------------
   'Total CC
   Me.TotalAmt = sngTotal
   Me.Refresh

   Set D = Nothing

End Sub