Changing a formula

[Kath via AccessMonster.com]

Hello, I need help in changing a formula..if anyone can help figure this out
I will be much obliged.
The module I am changing is below. The new formula is as such:

Match - pays $0.50 on the $1.00 up to 6% of salary

Profit sharing is 2% of salary

Module:
Option Compare Database

Public Function CalculateEmployerMatch(vnt401kDEF As Variant, _
vntGrossComp As Variant, _
vntEligible As Variant) As Double

On Error GoTo err_handler

Dim dbl401kDEF As Double
Dim dblGrossComp As Double
Dim dblEmployeeContributionPCT As Double
Dim dblEmployeeContributionPCT_rounded As Double


'=========================================================================
'IF NOT ELIGIBLE THEN RETURN ZERO

'=========================================================================
If IsNull(vntEligible) Then
CalculateEmployerMatch = 0
Exit Function
ElseIf UCase(Trim(vntEligible)) = "N" Then
CalculateEmployerMatch = 0
Exit Function
End If

'=========================================================================

'=========================================================================

If IsNull(vnt401kDEF) Then
dbl401kDEF = 0
Else
If IsNumeric(vnt401kDEF) Then
dbl401kDEF = CDbl(vnt401kDEF)
Else
dbl401kDEF = 0
End If
End If

If IsNull(vntGrossComp) Then
dblGrossComp = 0
Else
If IsNumeric(vntGrossComp) Then
dblGrossComp = CDbl(vntGrossComp)
Else
dblGrossComp = 0
End If
End If

dblEmployeeContributionPCT_notRounded = ((dbl401kDEF / dblGrossComp) *
100)
dblEmployeeContributionPCT = Round(((dbl401kDEF / dblGrossComp) * 100), 0)


If dblEmployeeContributionPCT_notRounded <= 1 Then

'==============================================================================================
'If the employee contribution is less than or equal to 1%, the
employer match will be 0

'==============================================================================================
CalculateEmployerMatch = 0

ElseIf (dblEmployeeContributionPCT_notRounded > 1) And
(dblEmployeeContributionPCT_notRounded <= 2) Then

'==============================================================================================
'If the employee contribution is greater than 1% and less than or
equal to 2%,
'the employer match is the amount of excess over 1%. For example, if
the contribution is
'1.5% the employer match will be .5%

'==============================================================================================
Dim newPCT As Double
newPCT = dblEmployeeContributionPCT_notRounded - 1
CalculateEmployerMatch = ((newPCT * dblGrossComp) / 100)
'CalculateEmployerMatch = dbl401kDEF

Else

'==============================================================================================
'If the employee contribution is greater than 2%, the employer match
will be 1%

'==============================================================================================
CalculateEmployerMatch = ((dblGrossComp) / 100)
'CalculateEmployerMatch = ((2 * dblGrossComp) / 100)

End If
Exit Function

err_handler:
Err.Clear
CalculateEmployerMatch = 0

End Function

Public Function GetEmpName(vntFname As Variant, vntLname As Variant) As
String

Dim strFname As String
Dim strLname As String

If IsNull(vntFname) Then
strFname = ""
Else
strFname = Trim(CStr(vntFname))
End If

If IsNull(vntLname) Then
strLname = ""
Else
strLname = Trim(CStr(vntLname))
End If

If Len(strFname) <= 0 And Len(strLname) <= 0 Then
GetEmpName = ""

ElseIf Len(strFname) <= 0 And Len(strLname) > 0 Then
GetEmpName = strLname

ElseIf Len(strFname) > 0 And Len(strLname) <= 0 Then
GetEmpName = strFname

Else
GetEmpName = strLname & " | " & strFname

End If


End Function

 

[SteveS]

Hi Kath,


See if the following function is what you want. It only calculates the
employer matching $$.

The profit sharing can be easily added to the function to give a combined $$
amount if you want/require.

Be sure the top two lines of any/all modules are

Option Compare Database
Option Explicit


'*********Begin function code *****
Public Function CalculateEmployerMatch(vnt401kDEF As Variant, _
vntGrossComp As Variant, _
vntEligible As Variant) As Double

' vnt401kDEF = $ amt of 401k deferal
'vntGrossComp= $ amt of gross wages
'vntEligible = text



'=========================================================================
' THIS FUNCTION DOES NOT CALCULATE OR RETURN PROFIT SHARING!!!
'=========================================================================



On Error GoTo err_handler

Dim dbl401kDEF As Double
Dim dblGrossComp As Double
Dim dblEmployeeContributionPCT As Double
'Dim dblEmployeeContributionPCT_notRounded As Double

'Match - pays $0.50 on the $1.00 up to 6% of salary
'Profit sharing is 2% of salary
Const MaxPct = 6
Const MatchingPct = 0.5

'initalize variables
CalculateEmployerMatch = 0
dbl401kDEF = 0
dblGrossComp = 0

'=========================================================================
'IF NOT ELIGIBLE THEN RETURN ZERO
'=========================================================================
If UCase(Trim(vntEligible)) = "N" Or UCase(Trim(Nz(vntEligible, ""))) =
"" Then
Exit Function
End If

'check vntGrossComp is numeric and >0
If IsNumeric(vntGrossComp) And vntGrossComp > 0 Then
dblGrossComp = CDbl(vntGrossComp)
Else
Exit Function
End If

'check vnt401kDEF
If IsNumeric(vnt401kDEF) Then
dbl401kDEF = CDbl(vnt401kDEF)
End If

'calculate 401k deferal %
'dblEmployeeContributionPCT_notRounded = ((dbl401kDEF / dblGrossComp) *
100)
dblEmployeeContributionPCT = Round(((dbl401kDEF / dblGrossComp) * 100), 0)

'make sure Contribution % not >6%
dblEmployeeContributionPCT = dblEmployeeContributionPCT - (MaxPct -
dblEmployeeContributionPCT) * (dblEmployeeContributionPCT > (MaxPct - 1))

'Calculate Employer Matching $$ amount
CalculateEmployerMatch = dblGrossComp * (dblEmployeeContributionPCT /
100) * MatchingPct

Exit Function

err_handler:
Err.Clear
CalculateEmployerMatch = 0

End Function
'******End code****************


HTH