Convert a formula to UDF Function

[jonsonbero]

Hi Everyone,
I have a long working formula that calculates based on conditions and this is the formula.
How can I change the formula to UDF Function? ... Can you please help me on this.
Please see the attachment file.. Thanks in advance.

[Paul_Hossler]

1. This gives the same result either way

+IF(B2*135%-INT(B2*135%)<0.75,INT(B2*135%),INT(B2*135%)))

2. You have 225% as a string. Much easier to enter 2.25 and format as percentage

3. The UDF also does some other cleanup on the data

4. You could do the math in one big long statement, but there's no need and it was easier to debug with byte-size pieces

Option Explicit


'=IF A2="Excellent" OR A2="very good" Or A2="good") Then
'   ROUND(SUM(B2*10/12,H2:J2,P2,T2),2)
'Else
'   ROUND(SUM(B2*10/12,D2:E2,M2:Q2,R2*B2,S2,T2,10,
'           IF(B2*135%-INT(B2*135%)<0.75,
'                INT(B2*135%)
'           Else INT(B2*135%))),2))


Function Something(Conditions As String, Titles As Range) As Variant
    Dim X As Double
    Dim ary As Variant
    Dim i As Long
    
    Something = CVErr(xlErrNA)
    
    On Error GoTo NiceExit
    
    '1 to 19
    ary = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Titles))
    
    For i = LBound(ary) To UBound(ary)
        'fix empty cells, % cells
        ary(i) = Val(Format(ary(i)))
    Next i
    
    Select Case LCase(Conditions)       '   A
        Case "excellent", "very good", "good"
            X = ary(1) * 10# / 12#  '   B
            X = X + ary(7) + ary(8) + ary(9) '   HIJ
            X = X + ary(15) + ary(19) '   PT
            
            Something = Round(X, 2)
        
        Case Else
            X = ary(1) * 10# / 12#   '   B
            X = X + ary(3) + ary(4)     '   DE
            X = X + ary(12) + ary(13) + ary(14) + ary(15) + ary(16)      '   MNOPQ
            X = X + ary(17) * ary(1)            '   RB
            X = X + ary(18) + ary(19) + 10#       '   ST+10
                
            If (ary(1) * 1.35 - Int(ary(1) * 1.35)) < 0.75 Then
                X = X + Int(ary(1) * 1.35)
            Else
                X = X + Int(ary(1) * 1.35)
            End If
            
            Something = Round(X, 2)
        End Select


NiceExit:


End Function

[jonsonbero]

Thanks to you sir for nice cooperation and given learning concept to me.
May I ask another question, there are two formulas, one in cell E2 and the other in cell J2
What I need is an example for each formula and I will try to apply it on my case on my own.
Again my sincere thanks for taking an interest in my problem.

[Paul_Hossler]

Lots of hardcoded parameters.

Option Explicit


'=IF(AND(TODAY()>=DATE(YEAR(D2),MONTH(D2)+1,1),TODAY()<=DATE(YEAR(D2),MONTH(D2)+37,0))
'   ,IF(MONTH(TODAY())-MONTH(D2)=1,
'        550*(C2*96.25%/550-INT(C2*96.25%/550))+C2*3.75%,
'        (C2-550*(C2*96.25%/550-INT(C2*96.25%/550))-C2*3.75%)/35),"")


Function Installment1(TheValue As Double, TheDate As Date) As Variant
    Dim Y As Long, M As Long, Yt As Long, Mt As Long
    Dim Nt As Long
    
    Installment1 = CVErr(xlErrNA)
    On Error GoTo NiceExit
    
    Y = Year(TheDate)
    M = Month(TheDate)
    Yt = Year(Now)
    Mt = Month(Now)
    Nt = Int(Now)
    
    If Nt >= DateSerial(Y, M + 1, 1) And Nt <= DateSerial(Y, M + 37, 0) Then
        If Mt - M = 1 Then
            Installment1 = 550 * TheValue * 0.9625 / 550 - Int(TheValue * 0.9625 / 550) + TheValue * 0.0375
        Else
            Installment1 = (TheValue - 550 * (TheValue * 0.9625 / 550 - Int(TheValue * 0.9625 / 550)) - TheValue * 0.0375) / 35
        End If
    
    Else
        Installment1 = vbNullString
    End If


NiceExit:


End Function




'=IF(AND(TODAY()>=DATE(YEAR(I2),MONTH(I2)+1,1),TODAY()<=DATE(YEAR(I2),MONTH(I2)+11,0))
'   ,H2/10,"")
'else
'   ""


Function Installment2(TheValue As Double, TheDate As Date) As Variant
    Dim Y As Long, M As Long, Yt As Long, Mt As Long
    Dim Nt As Long
    Dim I As Double
    
    Installment2 = CVErr(xlErrNA)
    On Error GoTo NiceExit
    
    Y = Year(TheDate)
    M = Month(TheDate)
    Yt = Year(Now)
    Mt = Month(Now)
    Nt = Int(Now)
    
    If Nt >= DateSerial(Y, M + 1, 1) And Nt <= DateSerial(Y, M + 11, 0) Then
        Installment2 = TheValue / 10
    Else
        Installment2 = vbNullString
    End If


NiceExit:


End Function

[Jan Karel Pieterse]

@jonsonbero One word of advice: User Defined Functions (UDF) are much slower than formulas written directly in cells using built-in Excel functions. I would advise to stay away from VBA for this and rather use formulas. If your formulas become to complicated, perhaps splitting the calculation across multiple is an option?

[Paul_Hossler]

@jonsonbero One word of advice: User Defined Functions (UDF) are much slower than formulas written directly in cells using built-in Excel functions.

I agree, but if the UDF is performed a limited number of times, I'd opt for the more easily understood logic of a UDF

However, if the calculation is going to be performed a gazillion times, then I'd write a sub to do all the calculations in VBA using arrays and just put the Values back to the worksheet. Re-run sub if data changes.

If I were doing this UDF for myself, I'd generalize it by passing optional defaulted calling parameters instead of hard coding values like the 550 and the .9625

[jonsonbero]

Your solutions are perfect ... They are both wonderful To achieve results
but Results should appear automatically without pressing double-click any cell
please change your computer’s date to 1/7/2020 Before opening the file to see what I mean.
Again, thanks so much

[Paul_Hossler]

Capture.JPG

I did change my clock, and then opened your file

Don't see anything unusual

The results won't change unless an input changes

[jonsonbero]

for illustration the UDF Function in the cell k2
Date of the total amount 1/6/2020
Beginning of the first installment 1/7/2020
The end of the last installment 1/4/2021
With the beginning of 1/5/2021 the cell output will become blank.
What I mean is When I change the computer’s date to 1/7/2020, Then I open the file. The results do not automatically appear.
In this case, I press double-click on the cell k2 to show the results ... This is what happens with me.
How can this be achieved automatically way?.. maybe I'm missing something obvious, so any help at all would be massively appreciated ..

[Paul_Hossler]

Capture.JPG

Again ...

I changed the computer's date to 7/1/2020 (US format)

Opened the file

And this is what I see

Double clicking K2 changes nothing



I don't understand what you mean by these

Beginning of the first installment 1/7/2020
The end of the last installment 1/4/2021
With the beginning of 1/5/2021 the cell output will become blank.

[jonsonbero]

Thanks sir . I wasn't clear in my question.... Apologies!
In your codes I have added this line

Application.Volatile

Now I could get it completely ..thanks a lot for great help

[jonsonbero]

I am so sorry for disturbing you again Mr. Paul_Hossler
I used another formula but it didn't work properly with me
Please have a look ...Thank you for your patience with me

[Paul_Hossler]

Two new lines marked <<<<<<<<<<<

Option Explicit


Function Something(Conditions As String, Titles As Range) As Variant
    
    Dim X As Double
    Dim ary As Variant
    Dim i As Long
    
    Something = CVErr(xlErrNA)
    On Error GoTo NiceExit
    
    ary = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Titles))
    For i = LBound(ary) To UBound(ary)
        ary(i) = Val(Format(ary(i)))
    Next i
    
    Select Case LCase(Conditions)
        Case "excellent", "very good", "good"
            X = ary(1) * 10# / 12#
            X = X + ary(5) + ary(8)
            If ary(2) >= 1440 Then X = X + ary(2) - 1440    '   <<<<<<<<<<
        
        Case Else
            X = ary(1) * 10# / 12#
            X = X + ary(3) + ary(4) + ary(13) + ary(14) + ary(20)
            X = X + ary(19) * ary(1)
                           
            If (ary(1) * 2.85 - Int(ary(1) * 2.85)) < 0.98 Then
                X = X + Int(ary(1) * 2.85)
            Else
                X = X + Int(ary(1) * 2.85)
            End If
            If ary(2) >= 1440 Then X = X + ary(2) - 1440    '   <<<<<<<<<<
    End Select


    Something = Round(X, 2)


NiceExit:
End Function

[jonsonbero]

Thank you very much Mr. Paul_Hossler
You are such a nice person and i respect for your kind time and help.

[Paul_Hossler]

No problem

Glad to help

[jonsonbero]

I am so sorry for disturbing you again Mr. Paul_Hossler
I used another formula but didn't work for me
Please have a look ... Again, thank you so much for all your time and help.

[Paul_Hossler]

Option Explicit


Function Something(Conditions As String, Title2 As Double, Title3 As Double) As Variant
    
    Something = CVErr(xlErrNA)
    On Error GoTo NiceExit
        
    Select Case LCase(Conditions)
     
        Case "excellent", "very good", "good"
            Something = Round(Title3 - Title2, 2) + Round(3.25 * Title2, 2) + Round(Title3 - Title2, 2) * 1.95
        Case Else
            Something = Round(Title3, 2) + Round(3.25 * Title2, 2) + Round(Title3, 2) * 1.95 + 300
        End Select
        
        Exit Function
NiceExit:
End Function

Capture.JPG

[jonsonbero]

Thanks to you sir for perfect cooperation and given learning concept to me.
Best Regards