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

G

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

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Sort by date Sort by votes
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
You must log in or register to reply here.

Similar threads

C
  • Question Question
Aggregate function assistance or some other function?
Replies
2
Views
571
cspengel
C
M
  • Question Question
If & And Condition based on lookup value change at every 30 row
Replies
2
Views
403
mba_110
M
K
  • Solved
Finding a group of specific values and Showing First and Last Value
2
Replies
10
Views
893
Fluff
Fluff
T
  • Question Question
incrementing and checking till getting value less than specified.
Replies
0
Views
745
trustmeasfrnd
T
M
  • Question Question
How to Set Up Loop to do Goal Seek of Range with Changing Rows and Columns
Replies
3
Views
3K
alansidman
A

Forum statistics

Threads
1,223,099
Messages
6,170,114
Members
452,302
Latest member
TaMere

Share this page

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