UDF working right but code is too long, please help clean up code

greegan

Well-known Member
Joined
Nov 18, 2009
Messages
643
Office Version
  1. 365
Platform
  1. Windows
This is part 2 of an ongoing problem and hopefully the last one for a while.
I've had some help on an earlier post regarding a compile error. That was resolved and I'm hoping this is not breaking any Forum protocols posting this code here.
I added it to the old post but realized it deserves its own thread.
I need to make this function smaller in size and I don't know how. You'll understand when you scroll through it.

Thank you,

-- g

Code:
Function GetTableIncr(Pg As Double, Period As String) As Double
    If Pg = 1 Then
        GetTableIncr = WorksheetFunction.Lookup(Period, Array("Biweekly", "Monthly", "Semi-Monthly", "Weekly"), _
        Array(4, 8, 4, 2))
    ElseIf Pg = 2 Then
        GetTableIncr = WorksheetFunction.Lookup(Period, Array("Biweekly", "Monthly", "Semi-Monthly", "Weekly"), _
        Array(8, 18, 8, 4))
    ElseIf Pg = 3 Then
        GetTableIncr = WorksheetFunction.Lookup(Period, Array("Biweekly", "Monthly", "Semi-Monthly", "Weekly"), _
        Array(16, 34, 18, 8))
    ElseIf Pg = 4 Then
        GetTableIncr = WorksheetFunction.Lookup(Period, Array("Biweekly", "Monthly", "Semi-Monthly", "Weekly"), _
        Array(24, 52, 26, 12))
    ElseIf Pg = 5 Then
        GetTableIncr = WorksheetFunction.Lookup(Period, Array("Biweekly", "Monthly", "Semi-Monthly", "Weekly"), _
        Array(32, 70, 34, 16))
    ElseIf Pg = 6 Then
        GetTableIncr = WorksheetFunction.Lookup(Period, Array("Biweekly", "Monthly", "Semi-Monthly", "Weekly"), _
        Array(40, 86, 44, 20))
 End If
 
End Function
Function FindFedIntPg(I As Long, Period As String, Cntry As String) As Variant
Dim GetIncrPg As Variant
Dim Cat0, Cat1, Cat2, Cat3, Cat4, Cat5, Cat6, Cat7 As Variant
Dim a, b, c, d, e, f, g As Variant
a = GetFedTableBase(Cntry, Period)
b = GetTableIncr(1, Period) * 54
c = GetTableIncr(2, Period) * 55
d = GetTableIncr(3, Period) * 55
e = GetTableIncr(4, Period) * 55
f = GetTableIncr(5, Period) * 55
g = GetTableIncr(6, Period) * 55
Cat0 = a - a
Cat1 = a
Cat2 = Cat1 + b
Cat3 = Cat2 + c
Cat4 = Cat3 + d
Cat5 = Cat4 + e
Cat6 = Cat5 + f
Cat7 = Cat6 + g
Dim Pg As Double
Dim Pgx As Variant
Dim j As Variant
Pgx = WorksheetFunction.Lookup(I, Array(Cat0, Cat1, Cat2, Cat3, Cat4, Cat5, Cat6, Cat7))
Pg = WorksheetFunction.Lookup(I, Array(Cat0, Cat1, Cat2, Cat3, Cat4, Cat5, Cat6, Cat7), Array(1, 2, 3, 4, 5, 6, 7))
j = GetTableIncr(Pg - 1, Period)
Dim y0, y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, y13, y14, y15, y16, y17, y18, y19, y20 As Variant
Dim y21, y22, y23, y24, y25, y26, y27, y28, y29, y30, y31, y32, y33, y34, y35, y36, y37, y38, y39 As Variant
Dim y40, y41, y42, y43, y44, y45, y46, y47, y48, y49, y50, y51, y52, y53, y54, y55 As Variant
y0 = Pgx
y1 = y0 + j
y2 = y1 + j
y3 = y2 + j
y4 = y3 + j
y5 = y4 + j
y6 = y5 + j
y7 = y6 + j
y8 = y7 + j
y9 = y8 + j
y10 = y9 + j
y11 = y10 + j
y12 = y11 + j
y13 = y12 + j
y14 = y13 + j
y15 = y14 + j
y16 = y15 + j
y17 = y16 + j
y18 = y17 + j
y19 = y18 + j
y20 = y19 + j
y21 = y20 + j
y22 = y21 + j
y23 = y22 + j
y24 = y23 + j
y25 = y24 + j
y26 = y25 + j
y27 = y26 + j
y28 = y27 + j
y29 = y28 + j
y30 = y29 + j
y31 = y30 + j
y32 = y31 + j
y33 = y32 + j
y34 = y33 + j
y35 = y34 + j
y36 = y35 + j
y37 = y36 + j
y38 = y37 + j
y39 = y38 + j
y40 = y39 + j
y41 = y40 + j
y42 = y41 + j
y43 = y42 + j
y44 = y43 + j
y45 = y44 + j
y46 = y45 + j
y47 = y46 + j
y48 = y47 + j
y49 = y48 + j
y50 = y49 + j
y51 = y50 + j
y52 = y51 + j
y53 = y52 + j
y54 = y53 + j
y55 = y54 + j
 

Dim l As Variant
l = WorksheetFunction.Lookup(I, Array(y0, y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, y13, y14, y15, y16, y17, y18, y19, y20, _
                                    y21, y22, y23, y24, y25, y26, y27, y28, y29, y30, y31, y32, y33, y34, y35, y36, y37, y38, y39, y40, _
                                    y41, y42, y43, y44, y45, y46, y47, y48, y49, y50, y51, y52, y53, y54, y55), Array(y0, y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, y13, y14, y15, y16, y17, y18, y19, y20, _
                                    y21, y22, y23, y24, y25, y26, y27, y28, y29, y30, y31, y32, y33, y34, y35, y36, y37, y38, y39, y40, _
                                    y41, y42, y43, y44, y45, y46, y47, y48, y49, y50, y51, y52, y53, y54, y55))
 
Dim h As Variant
h = l + j

FindFedIntPg = WorksheetFunction.Median(l, h)
 
End Function
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
This version is a bit tidier
Code:
Function GetTableIncr(Pg As Double, Period As String) As Double
    Dim resultArray As Variant
    
    If Pg = 1 Then
        resultArray = Array(4, 8, 4, 2)
    ElseIf Pg = 2 Then
        resultArray = Array(8, 18, 8, 4)
    ElseIf Pg = 3 Then
        resultArray = Array(16, 34, 18, 8)
    ElseIf Pg = 4 Then
        resultArray = Array(24, 52, 26, 12)
    ElseIf Pg = 5 Then
        resultArray = Array(32, 70, 34, 16)
    ElseIf Pg = 6 Then
        resultArray = Array(40, 86, 44, 20)
    Else
        MsgBox "bad pg"
        Exit Function
    End If
    
    GetTableIncr = WorksheetFunction.Lookup(Period, Array("Biweekly", "Monthly", "Semi-Monthly", "Weekly"), resultArray)
End Function
 
Upvote 0
Thank you for your reply, it does work much better thank you. However it seems I included two Functions in that tag which I had only intended to include the one below, which does need cleaning up.

-- g

Code:
Function FindFedIntPg(I As Long, Period As String, Cntry As String) As Variant
Dim GetIncrPg As Variant
Dim Cat0, Cat1, Cat2, Cat3, Cat4, Cat5, Cat6, Cat7 As Variant
Dim a, b, c, d, e, f, g As Variant
a = GetFedTableBase(Cntry, Period)
b = GetTableIncr(1, Period) * 54
c = GetTableIncr(2, Period) * 55
d = GetTableIncr(3, Period) * 55
e = GetTableIncr(4, Period) * 55
f = GetTableIncr(5, Period) * 55
g = GetTableIncr(6, Period) * 55
Cat0 = a - a
Cat1 = a
Cat2 = Cat1 + b
Cat3 = Cat2 + c
Cat4 = Cat3 + d
Cat5 = Cat4 + e
Cat6 = Cat5 + f
Cat7 = Cat6 + g
Dim Pg As Double
Dim Pgx As Variant
Dim j As Variant
Pgx = WorksheetFunction.Lookup(I, Array(Cat0, Cat1, Cat2, Cat3, Cat4, Cat5, Cat6, Cat7))
Pg = WorksheetFunction.Lookup(I, Array(Cat0, Cat1, Cat2, Cat3, Cat4, Cat5, Cat6, Cat7), Array(1, 2, 3, 4, 5, 6, 7))
j = GetTableIncr(Pg - 1, Period)
Dim y0, y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, y13, y14, y15, y16, y17, y18, y19, y20 As Variant
Dim y21, y22, y23, y24, y25, y26, y27, y28, y29, y30, y31, y32, y33, y34, y35, y36, y37, y38, y39 As Variant
Dim y40, y41, y42, y43, y44, y45, y46, y47, y48, y49, y50, y51, y52, y53, y54, y55 As Variant
y0 = Pgx
y1 = y0 + j
y2 = y1 + j
y3 = y2 + j
y4 = y3 + j
y5 = y4 + j
y6 = y5 + j
y7 = y6 + j
y8 = y7 + j
y9 = y8 + j
y10 = y9 + j
y11 = y10 + j
y12 = y11 + j
y13 = y12 + j
y14 = y13 + j
y15 = y14 + j
y16 = y15 + j
y17 = y16 + j
y18 = y17 + j
y19 = y18 + j
y20 = y19 + j
y21 = y20 + j
y22 = y21 + j
y23 = y22 + j
y24 = y23 + j
y25 = y24 + j
y26 = y25 + j
y27 = y26 + j
y28 = y27 + j
y29 = y28 + j
y30 = y29 + j
y31 = y30 + j
y32 = y31 + j
y33 = y32 + j
y34 = y33 + j
y35 = y34 + j
y36 = y35 + j
y37 = y36 + j
y38 = y37 + j
y39 = y38 + j
y40 = y39 + j
y41 = y40 + j
y42 = y41 + j
y43 = y42 + j
y44 = y43 + j
y45 = y44 + j
y46 = y45 + j
y47 = y46 + j
y48 = y47 + j
y49 = y48 + j
y50 = y49 + j
y51 = y50 + j
y52 = y51 + j
y53 = y52 + j
y54 = y53 + j
y55 = y54 + j


Dim l As Variant
l = WorksheetFunction.Lookup(I, Array(y0, y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, y13, y14, y15, y16, y17, y18, y19, y20, _
                                    y21, y22, y23, y24, y25, y26, y27, y28, y29, y30, y31, y32, y33, y34, y35, y36, y37, y38, y39, y40, _
                                    y41, y42, y43, y44, y45, y46, y47, y48, y49, y50, y51, y52, y53, y54, y55), Array(y0, y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, y13, y14, y15, y16, y17, y18, y19, y20, _
                                    y21, y22, y23, y24, y25, y26, y27, y28, y29, y30, y31, y32, y33, y34, y35, y36, y37, y38, y39, y40, _
                                    y41, y42, y43, y44, y45, y46, y47, y48, y49, y50, y51, y52, y53, y54, y55))

Dim h As Variant
h = l + j

FindFedIntPg = WorksheetFunction.Median(l, h)

End Function
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,106
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top