VBA Loop and UDF

[STEVEMILLS04]

Good morning/afternoon!

I am trying to create a button that will run a calculation for me based on a custom function. It keeps returning 0, which is my Case Else statement.

I debugged to make sure my data is in the appropriate columns. Hiredate is column J and Potential is column T.

Here is my button click code:

Private Sub CommandButton1_Click()
lastRow = 32 'Cells(Rows.Count, 21).End(xlUp).Row




For nRow = 15 To lastRow
    Dim sDate As Date
    sDate = Cells(nRow, 10)
    
    Dim pBonus As Currency
    pBonus = Cells(nRow, 20)
    
    Cells(nRow, 21) = prbonus(sDate, pBonus)
    
Next nRow


End Sub

and here is my UDF with a case statement:

Function prbonus(HireDate As Date, Potential As Currency) As Currency
Dim result As Currency
Select Case HireDate
    Case Month(HireDate) = 1 And Year(HireDate) = 2015
        result = Potential * (11 / 12)
    Case Month(HireDate) = 2 And Year(HireDate) = 2015
        result = Potential * (10 / 12)
    Case Month(HireDate) = 3 And Year(HireDate) = 2015
        result = Potential * (9 / 12)
    Case Month(HireDate) = 4 And Year(HireDate) = 2015
        result = Potential * (8 / 12)
    Case Month(HireDate) = 5 And Year(HireDate) = 2015
        result = Potential * (7 / 12)
    Case Month(HireDate) = 6 And Year(HireDate) = 2015
        result = Potential * (6 / 12)
    Case Month(HireDate) = 7 And Year(HireDate) = 2015
        result = Potential * (5 / 12)
    Case Month(HireDate) = 8 And Year(HireDate) = 2015
        result = Potential * (4 / 12)
    Case Month(HireDate) = 9 And Year(HireDate) = 2015
        result = Potential * (3 / 12)
    Case Month(HireDate) = 10 And Year(HireDate) = 2015
        result = Potential * (2 / 12)
    Case Month(HireDate) = 11 And Year(HireDate) = 2015
        result = Potential * (1 / 12)
    Case Month(HireDate) = 12 And Year(HireDate) = 2015
        result = 0
    Case Year(HireDate) < 2015
        result = Potential
    Case Else
        result = 0
    End Select
    
    prbonus = result
     
End Function

 

[Norie]

Something like Month(HireDate) = 1 And Year(HireDate) = 2015 will return a boolean value True/False.

A boolean value will never match a date, for example HireDate.

You might be able to keep the same structure for the Select Case if you change HireDate to True.

Function prbonus(HireDate As Date, Potential As Currency) As Currency
Dim result As Currency
Select Case True
    Case Month(HireDate) = 1 And Year(HireDate) = 2015
        result = Potential * (11 / 12)
    Case Month(HireDate) = 2 And Year(HireDate) = 2015
        result = Potential * (10 / 12)
    Case Month(HireDate) = 3 And Year(HireDate) = 2015
        result = Potential * (9 / 12)
    Case Month(HireDate) = 4 And Year(HireDate) = 2015
        result = Potential * (8 / 12)
    Case Month(HireDate) = 5 And Year(HireDate) = 2015
        result = Potential * (7 / 12)
    Case Month(HireDate) = 6 And Year(HireDate) = 2015
        result = Potential * (6 / 12)
    Case Month(HireDate) = 7 And Year(HireDate) = 2015
        result = Potential * (5 / 12)
    Case Month(HireDate) = 8 And Year(HireDate) = 2015
        result = Potential * (4 / 12)
    Case Month(HireDate) = 9 And Year(HireDate) = 2015
        result = Potential * (3 / 12)
    Case Month(HireDate) = 10 And Year(HireDate) = 2015
        result = Potential * (2 / 12)
    Case Month(HireDate) = 11 And Year(HireDate) = 2015
        result = Potential * (1 / 12)
    Case Month(HireDate) = 12 And Year(HireDate) = 2015
        result = 0
    Case Year(HireDate) < 2015
        result = Potential
    Case Else
        result = 0
    End Select
    
    prbonus = result
     
End Function

 

[JoeMo]

Something like Month(HireDate) = 1 And Year(HireDate) = 2015 will return a boolean value True/False.

A boolean value will never match a date, for example HireDate.

You might be able to keep the same structure for the Select Case if you change HireDate to True.

Function prbonus(HireDate As Date, Potential As Currency) As Currency
Dim result As Currency
Select Case True
    Case Month(HireDate) = 1 And Year(HireDate) = 2015
        result = Potential * (11 / 12)
    Case Month(HireDate) = 2 And Year(HireDate) = 2015
        result = Potential * (10 / 12)
    Case Month(HireDate) = 3 And Year(HireDate) = 2015
        result = Potential * (9 / 12)
    Case Month(HireDate) = 4 And Year(HireDate) = 2015
        result = Potential * (8 / 12)
    Case Month(HireDate) = 5 And Year(HireDate) = 2015
        result = Potential * (7 / 12)
    Case Month(HireDate) = 6 And Year(HireDate) = 2015
        result = Potential * (6 / 12)
    Case Month(HireDate) = 7 And Year(HireDate) = 2015
        result = Potential * (5 / 12)
    Case Month(HireDate) = 8 And Year(HireDate) = 2015
        result = Potential * (4 / 12)
    Case Month(HireDate) = 9 And Year(HireDate) = 2015
        result = Potential * (3 / 12)
    Case Month(HireDate) = 10 And Year(HireDate) = 2015
        result = Potential * (2 / 12)
    Case Month(HireDate) = 11 And Year(HireDate) = 2015
        result = Potential * (1 / 12)
    Case Month(HireDate) = 12 And Year(HireDate) = 2015
        result = 0
    Case Year(HireDate) < 2015
        result = Potential
    Case Else
        result = 0
    End Select
    
    prbonus = result
     
End Function

But Post #9 would be a lot simpler.

 

[STEVEMILLS04]

I would re-write this function as follows:

Function prbonus(HireDate As Date, Potential As Currency) As Currency
    If Year(HireDate) <> 2015 Then Exit Function
    Select Case Month(HireDate)
        Case 1: prbonus = Potential * (11 / 12)
        Case 2: prbonus = Potential * (10 / 12)
        Case 3: prbonus = Potential * (9 / 12)
        Case 4: prbonus = Potential * (8 / 12)
        Case 5: prbonus = Potential * (7 / 12)
        Case 6: prbonus = Potential * (6 / 12)
        Case 7: prbonus = Potential * (5 / 12)
        Case 8: prbonus = Potential * (4 / 12)
        Case 9: prbonus = Potential * (3 / 12)
        Case 10: prbonus = Potential * (2 / 12)
        Case 11: prbonus = Potential * (1 / 12)
        Case 12: prbonus = 0
    End Select
End Function

Ok, that worked! I made a few edits to the button code to handle cases where the year is less than or <> to 2015.

Thank you all so much for your help!

Private Sub CommandButton1_Click()lastRow = 32 'Cells(Rows.Count, 21).End(xlUp).Row




For nRow = 15 To lastRow
    Dim sDate As Date
    sDate = Cells(nRow, 10)
    
    Dim pBonus As Currency
    pBonus = Cells(nRow, 20)
    
    If Year(sDate) < 2015 Then
        Cells(nRow, 21) = pBonus
    ElseIf Year(sDate) = 2015 Then
        Cells(nRow, 21) = prbonus(sDate, pBonus)
    Else: Cells(nRow, 21) = 0
    End If
        
Next nRow


End Sub

 

[Norie]

Joe

Not using a UDF might be even simpler.

 

[JoeMo]

Joe

Not using a UDF might be even simpler.

But not nearly as much fun Norie!

 

[STEVEMILLS04]

But not nearly as much fun Norie!

I know it is not ready yet, but eventually I plan to use it often in other workbooks and such so it will save me lots of time over doing an IF function each time.

And it was fun to learn