Consulting

Results 1 to 15 of 15

Thread: Convert a formula to UDF Function

  1. #1

    Convert a formula to UDF Function

    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.
    Attached Files Attached Files

  2. #2
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,194
    Location
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul

    Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    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.
    Attached Files Attached Files

  4. #4
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,194
    Location
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul

    Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  5. #5
    @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?
    Regards,

    Jan Karel Pieterse
    Excel MVP jkp-ads.com

  6. #6
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,194
    Location
    Quote Originally Posted by Jan Karel Pieterse View Post
    @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
    ---------------------------------------------------------------------------------------------------------------------

    Paul

    Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  7. #7
    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
    Attached Files Attached Files

  8. #8
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,194
    Location
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul

    Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  9. #9
    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 ..
    Last edited by jonsonbero; 06-26-2020 at 04:16 PM.

  10. #10
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,194
    Location
    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.
    ---------------------------------------------------------------------------------------------------------------------

    Paul

    Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  11. #11
    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

  12. #12
    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
    Attached Files Attached Files

  13. #13
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,194
    Location
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul

    Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

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

  15. #15
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,194
    Location
    No problem

    Glad to help
    ---------------------------------------------------------------------------------------------------------------------

    Paul

    Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •