cyber553
08-12-2009, 10:09 AM
I have created a custom function (GetData) that I use to pull data from a "database" (which I update in the Fin_Data tab). It works well, however the report I need requires that I use requires that I call this function in 10,000+ cells, and as a result the report takes over 4 hours to recalculate. I would really appreciate any help/advice/code-tweaks/changes that could be offered to cut down on this run-time, thanks in advance!
I've included the function below and attached a sample spreadsheet with report to facilitate/encourage tinkering. The data source is normally ~11,000 rows and the report itself is 1,000 rows and has an additional 50 columns but has been reduced to accommodate the file size limitations to upload here.
Function GetData(IInum As String, Scenario As String, Version As String, FinCat As String, _
FinType As String, Yr As String, Func As String, Acct As String, Region As String, OngComp As String, _
RunInc As String, Vw As String, Mnth As String) As Double
' This is some help on this function!
Application.Volatile (True)
Dim FinalDataRow As Double, DataColumn As Double
Dim IIidCol As Double, ScenarioCol As Double, VersionCol As Double, FinTypeACol As Double
Dim FinTypeBCol As Double, YearCol As Double, FunctionCol As Double, AcctCol As Double
Dim RegionCol As Double, OngCompCol As Double, RunIncCol As Double
Dim PLViewCol As Double, CashViewCol As Double, CapViewCol As Double, BusUnitCol As Double
Dim i As Integer, MnthNum As Integer
With ThisWorkbook.Worksheets("Fin_Data")
'Define Columns
IIidCol = .Range("1:1").Find(What:="ITM_ID", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
ScenarioCol = .Range("1:1").Find(What:="SCENARIO_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
VersionCol = .Range("1:1").Find(What:="VERSION_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
FinCatCol = .Range("1:1").Find(What:="FIN_CAT_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
FinTypeCol = .Range("1:1").Find(What:="FIN_TYPE_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
YearCol = .Range("1:1").Find(What:="YR_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
FunctionCol = .Range("1:1").Find(What:="FXNL_AREA_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
AcctCol = .Range("1:1").Find(What:="ACCT_TYPE_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
RegionCol = .Range("1:1").Find(What:="RGN_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
OngCompCol = .Range("1:1").Find(What:="CPLT_ONG_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
RunIncCol = .Range("1:1").Find(What:="FIN_SUB_TYPE_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
PLViewCol = .Range("1:1").Find(What:="PL_VW", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
CashViewCol = .Range("1:1").Find(What:="CASH_VW", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
CapViewCol = .Range("1:1").Find(What:="CAP_VW", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
BusUnitCol = .Range("1:1").Find(What:="Bus Unit", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
If Mnth = "Q1" Then
DataColumn = .Range("1:1").Find(What:="Q1 Total", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
ElseIf Mnth = "Q2" Then
DataColumn = .Range("1:1").Find(What:="Q2 Total", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
ElseIf Mnth = "Q3" Then
DataColumn = .Range("1:1").Find(What:="Q3 Total", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
ElseIf Mnth = "Q4" Then
DataColumn = .Range("1:1").Find(What:="Q4 Total", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
ElseIf Mnth > 0 And Mnth < 13 Then
MnthNum = CInt(Mnth)
DataColumn = MnthNum - 1 + .Range("1:1").Find(What:="JAN", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
Else 'Month # is invalid, give FY number
DataColumn = .Range("1:1").Find(What:="FY Total", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
End If
FinalDataRow = .Cells(Application.Rows.Count, 1).End(xlUp).Row
GetData = 0
For i = 2 To FinalDataRow
If .Cells(i, IIidCol).Value = IInum Or IInum = "ALL" Or .Cells(i, BusUnitCol).Value = IInum Then 'Check II Number
If .Cells(i, ScenarioCol).Value = Scenario Or Scenario = "ALL" Then 'Check Scenario
If .Cells(i, VersionCol).Value = Version Or Version = "ALL" Then 'Check Version
If .Cells(i, FinCatCol).Value = FinCat Or FinCat = "ALL" Then 'Check Financial Category (Dir, Indr, Res)
If .Cells(i, FinTypeCol).Value = FinType Or FinType = "ALL" Then 'Check Fin Type (Revenue, Save, Spend)
If .Cells(i, YearCol).Value = Yr Or Yr = "ALL" Then 'Check Year
If .Cells(i, FunctionCol).Value = Func Or Func = "ALL" Then 'Check Functional Area
If .Cells(i, AcctCol).Value = Acct Or Acct = "ALL" Then 'Check Account
If .Cells(i, RegionCol).Value = Region Or Region = "ALL" Then 'Check Region
If .Cells(i, OngCompCol).Value = OngComp Or OngComp = "ALL" Then 'Check Ongoing/Completion
If .Cells(i, RunIncCol).Value = RunInc Or RunInc = "ALL" Then 'Check Run-Rate/Incremental
If (Vw = "PL" And .Cells(i, PLViewCol).Value = 1) Or (Vw = "Cash" And .Cells(i, CashViewCol).Value = 1) Or (Vw = "Cap" And .Cells(i, CapViewCol).Value = 1) Then 'Check View to be shown
If (Vw = "Cap" And .Cells(i, AcctCol).Value Like "*Credit*") Then
GetData = GetData - .Cells(i, DataColumn).Value
Else
GetData = GetData + .Cells(i, DataColumn).Value
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next i
End With
End Function
I've included the function below and attached a sample spreadsheet with report to facilitate/encourage tinkering. The data source is normally ~11,000 rows and the report itself is 1,000 rows and has an additional 50 columns but has been reduced to accommodate the file size limitations to upload here.
Function GetData(IInum As String, Scenario As String, Version As String, FinCat As String, _
FinType As String, Yr As String, Func As String, Acct As String, Region As String, OngComp As String, _
RunInc As String, Vw As String, Mnth As String) As Double
' This is some help on this function!
Application.Volatile (True)
Dim FinalDataRow As Double, DataColumn As Double
Dim IIidCol As Double, ScenarioCol As Double, VersionCol As Double, FinTypeACol As Double
Dim FinTypeBCol As Double, YearCol As Double, FunctionCol As Double, AcctCol As Double
Dim RegionCol As Double, OngCompCol As Double, RunIncCol As Double
Dim PLViewCol As Double, CashViewCol As Double, CapViewCol As Double, BusUnitCol As Double
Dim i As Integer, MnthNum As Integer
With ThisWorkbook.Worksheets("Fin_Data")
'Define Columns
IIidCol = .Range("1:1").Find(What:="ITM_ID", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
ScenarioCol = .Range("1:1").Find(What:="SCENARIO_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
VersionCol = .Range("1:1").Find(What:="VERSION_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
FinCatCol = .Range("1:1").Find(What:="FIN_CAT_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
FinTypeCol = .Range("1:1").Find(What:="FIN_TYPE_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
YearCol = .Range("1:1").Find(What:="YR_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
FunctionCol = .Range("1:1").Find(What:="FXNL_AREA_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
AcctCol = .Range("1:1").Find(What:="ACCT_TYPE_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
RegionCol = .Range("1:1").Find(What:="RGN_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
OngCompCol = .Range("1:1").Find(What:="CPLT_ONG_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
RunIncCol = .Range("1:1").Find(What:="FIN_SUB_TYPE_NM", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
PLViewCol = .Range("1:1").Find(What:="PL_VW", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
CashViewCol = .Range("1:1").Find(What:="CASH_VW", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
CapViewCol = .Range("1:1").Find(What:="CAP_VW", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
BusUnitCol = .Range("1:1").Find(What:="Bus Unit", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
If Mnth = "Q1" Then
DataColumn = .Range("1:1").Find(What:="Q1 Total", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
ElseIf Mnth = "Q2" Then
DataColumn = .Range("1:1").Find(What:="Q2 Total", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
ElseIf Mnth = "Q3" Then
DataColumn = .Range("1:1").Find(What:="Q3 Total", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
ElseIf Mnth = "Q4" Then
DataColumn = .Range("1:1").Find(What:="Q4 Total", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
ElseIf Mnth > 0 And Mnth < 13 Then
MnthNum = CInt(Mnth)
DataColumn = MnthNum - 1 + .Range("1:1").Find(What:="JAN", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
Else 'Month # is invalid, give FY number
DataColumn = .Range("1:1").Find(What:="FY Total", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False).Column
End If
FinalDataRow = .Cells(Application.Rows.Count, 1).End(xlUp).Row
GetData = 0
For i = 2 To FinalDataRow
If .Cells(i, IIidCol).Value = IInum Or IInum = "ALL" Or .Cells(i, BusUnitCol).Value = IInum Then 'Check II Number
If .Cells(i, ScenarioCol).Value = Scenario Or Scenario = "ALL" Then 'Check Scenario
If .Cells(i, VersionCol).Value = Version Or Version = "ALL" Then 'Check Version
If .Cells(i, FinCatCol).Value = FinCat Or FinCat = "ALL" Then 'Check Financial Category (Dir, Indr, Res)
If .Cells(i, FinTypeCol).Value = FinType Or FinType = "ALL" Then 'Check Fin Type (Revenue, Save, Spend)
If .Cells(i, YearCol).Value = Yr Or Yr = "ALL" Then 'Check Year
If .Cells(i, FunctionCol).Value = Func Or Func = "ALL" Then 'Check Functional Area
If .Cells(i, AcctCol).Value = Acct Or Acct = "ALL" Then 'Check Account
If .Cells(i, RegionCol).Value = Region Or Region = "ALL" Then 'Check Region
If .Cells(i, OngCompCol).Value = OngComp Or OngComp = "ALL" Then 'Check Ongoing/Completion
If .Cells(i, RunIncCol).Value = RunInc Or RunInc = "ALL" Then 'Check Run-Rate/Incremental
If (Vw = "PL" And .Cells(i, PLViewCol).Value = 1) Or (Vw = "Cash" And .Cells(i, CashViewCol).Value = 1) Or (Vw = "Cap" And .Cells(i, CapViewCol).Value = 1) Then 'Check View to be shown
If (Vw = "Cap" And .Cells(i, AcctCol).Value Like "*Credit*") Then
GetData = GetData - .Cells(i, DataColumn).Value
Else
GetData = GetData + .Cells(i, DataColumn).Value
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next i
End With
End Function