nepotist
03-28-2011, 01:15 PM
Hello,
Below is one of my macros for a projects. As you can see that I am passing two arguments passing through the function. This function uses the row number referenced by the first argument and then pulls values from different columns in that row and then based on the time period of analysis (second argument) it does the respective Vlookup.
When I change the data in the row(not the argument cell) which are used by the function. it wouldn't update the values unless I set Application.volatile = true and which also slows down by the workbook. I have about 12 sheets in the same workbook that use three more functions like this.
After reading a bit about Application.Volatile method, It calculated the entire sheet when ever there is a change in any cell. I figured that should I pass every cell value used in this function as an argument in order to avoid the use of volatile method, which defeats my purpose of writing the macro. Can some one please help me out how I could make this work other than re-writing the macro with all the arguments.
Function Service_Volume(rn As Range, YPeriod As String) As Long
'Macro written by V.V.
'Yperiod is the analysis Term (E Existing,M Mid-Term,L Long-Term)
Dim TPeriod As String
Dim F_T As String
Dim Lookup_Rn As Range
Dim Column_Lookup As Integer
Dim LOS_Standard As String
Dim i As Integer
On Error GoTo Line1
i = rn.Row
Set Lookup_Rn = Sheets("GSV_Database").Range("C:V")
'temporary refernce to the Time period of analysis needs to be updated
TPeriod = ActiveSheet.Cells(4, 33) ' Time period of analysis
F_T = Facility(rn, YPeriod)
'Check for LOS standard with respect to the analysis term
If (YPeriod = "E") Then
LOS_Standard = Cells(i, 18)
ElseIf (YPeriod = "M") Then
LOS_Standard = Cells(i, 36)
ElseIf (YPeriod = "L") Then
LOS_Standard = Cells(i, 43)
End If
'Service volume lookup with respect to the time period of analysis
Select Case TPeriod
Case "DAILY":
If LOS_Standard = "A" Then
Column_Lookup = 4
ElseIf LOS_Standard = "B" Then
Column_Lookup = 5
ElseIf LOS_Standard = "C" Then
Column_Lookup = 6
ElseIf LOS_Standard = "D" Then
Column_Lookup = 7
ElseIf LOS_Standard = "E" Then
Column_Lookup = 8
End If
Service_Volume = WorksheetFunction.VLookup(F_T, Lookup_Rn, Column_Lookup, False)
Case "PEAK HOUR TWO-WAY":
If LOS_Standard = "A" Then
Column_Lookup = 10
ElseIf LOS_Standard = "B" Then
Column_Lookup = 11
ElseIf LOS_Standard = "C" Then
Column_Lookup = 12
ElseIf LOS_Standard = "D" Then
Column_Lookup = 13
ElseIf LOS_Standard = "E" Then
Column_Lookup = 14
End If
Service_Volume = WorksheetFunction.VLookup(F_T, Lookup_Rn, Column_Lookup, False)
Case "PEAK HOUR PEAK DIRECTION":
If LOS_Standard = "A" Then
Column_Lookup = 16
ElseIf LOS_Standard = "B" Then
Column_Lookup = 17
ElseIf LOS_Standard = "C" Then
Column_Lookup = 18
ElseIf LOS_Standard = "D" Then
Column_Lookup = 19
ElseIf LOS_Standard = "E" Then
Column_Lookup = 20
End If
Service_Volume = WorksheetFunction.VLookup(F_T, Lookup_Rn, Column_Lookup, False)
End Select
Exit Function
Line1:
MsgBox Error.Description
End Function
Function Class(rn As Range) As String
'Marco used to determine the class of roadway segment V.V
Dim Cl As Variant
Dim i As Integer
i = rn.Row
Dim At As String
At = Cells(i, 17) ' Arterial type (Highway, Freeway, Arterial..)
Cl = Cells(i, 22) ' Signal Density of the roadway segment
If (At = "F") Then
Class = "F"
ElseIf (Cl < 2) And Cl <> 0 Then Class = 1
ElseIf (Cl >= 2 And Cl <= 4.5) Then Class = 2
ElseIf Cl = 0 Then
Class = 0
Else: Class = 3
End If
End Function
Function Facility_Type(rn As Range) As String
' MACRO used to determine the facility type of the roadwaysegment V.V
Dim i As Integer
i = rn.Row
Dim Area As String
Area = Cells(i, 16) ' Existing area type , the area type remains constant irrepective of the analysis period
Dim Fac_Type As String
Dim Clas As String
Clas = Class(rn)
If Clas = "F" Then
Fac_Type = "FW"
ElseIf (Area = "UA" Or Area = "TA") And Clas <> 0 Then
Fac_Type = "S2WAC" & Clas
ElseIf (Area = "UA" Or Area = "TA") And Clas = 0 Then
Fac_Type = "UFH"
ElseIf (Area = "RUA" Or Area = "RDA") And Clas <> 0 Then
Fac_Type = "IFH"
ElseIf (Area = "RUA" Or Area = "RDA") And Clas = 0 Then
Fac_Type = "UFH"
End If
Facility_Type = Fac_Type
End Function
Function Facility(rn As Range, Period As String) As String
' MACRO used to determine the facility Code to lookup Service Volumes of the roadwaysegment V.V
Dim i As Integer
Dim Area As String ' Area Type
Dim Fac_Type As String ' Facility type parameter
Dim One_Two As String ' one way two parameter
Dim ELanes As Integer
Dim MLanes As Integer
Dim LLanes As Integer
Dim DU As String ' divided undivided parameter
Dim Left As String ' left turn lanes parameter
Dim right As String ' right turn lanes parameter
i = rn.Row
Fac_Type = Facility_Type(rn)
Area = Cells(i, 16).Value
One_Two = Cells(i, 25).Value
DU = Cells(i, 24).Value
If (DU = "1W") Then
DU = "U"
Else: DU = DU
End If
Select Case Period
Case "E":
'Existing Period of analysis
ELanes = Cells(i, 28).Value 'Existing number of lanes
'Check for One way facility
' If (DU = "1W") Then
' DU = "U"
' End If
'Check for DU with lanes more than two
If ((ELanes >= 2) And One_Two <> "1W" And DU = "D") Then
Left = "WL"
Else
Left = Cells(i, 26).Value 'exisitng left turn lanes information
End If
right = Cells(i, 27).Value ' existing right turn lanes information
If Fac_Type = "FW" Then
Facility = Area & "_" & Fac_Type & "_" & ELanes & "L_" & right
Else
Facility = Area & "_" & Fac_Type & "_" & One_Two & "_" & ELanes & "L_" & DU & "_" & Left & "_" & right
End If
Case "M":
ELanes = Cells(i, 28).Value ' existing lane information
MLanes = Cells(i, 35).Value ' E+C (Mid-Term) lane information
'Check for DU with lanes more than existing conditions
If ((MLanes - ELanes) <> 0 And DU <> "1W" And DU <> "D") Then
DU = "D"
End If
'Check for Left turn parameter if the future number of lanes in more than two and is not one way street, by default the left
'turn lanes should be considered
If ((MLanes >= 2) And One_Two <> "1W" And DU = "D") Then
Left = "WL"
Else
Left = Cells(i, 38).Value ' Future Left Turn bay information
End If
right = Cells(i, 39).Value ' Future Right Turn bay information
'Facility code for E+C conditions
If Fac_Type = "FW" Then
Facility = Area & "_" & Fac_Type & "_" & MLanes & "L_" & right
Else
Facility = Area & "_" & Fac_Type & "_" & One_Two & "_" & MLanes & "L_" & DU & "_" & Left & "_" & right
End If
Case "L":
ELanes = Cells(i, 28).Value ' Existing number of Lanes
LLanes = Cells(i, 42).Value ' Long range number of lanes
'Check for DU with lanes more than existing conditions
If ((LLanes - ELanes) >= 2 And DU <> "1W" And DU <> "D") Then
DU = "D"
End If
If ((LLanes >= 2) And One_Two <> "1W" And DU = "D") Then
Left = "WL"
Else
Left = Cells(i, 45).Value ' Future Left Turn bay information
End If
right = Cells(i, 46).Value ' Future Right Turn bay information
'Facitlity code for Long term
If Fac_Type = "FW" Then
Facility = Area & "_" & Fac_Type & "_" & LLanes & "L_" & right
Else
Facility = Area & "_" & Fac_Type & "_" & One_Two & "_" & LLanes & "L_" & DU & "_" & Left & "_" & right
End If
End Select
End Function
Thank you
Below is one of my macros for a projects. As you can see that I am passing two arguments passing through the function. This function uses the row number referenced by the first argument and then pulls values from different columns in that row and then based on the time period of analysis (second argument) it does the respective Vlookup.
When I change the data in the row(not the argument cell) which are used by the function. it wouldn't update the values unless I set Application.volatile = true and which also slows down by the workbook. I have about 12 sheets in the same workbook that use three more functions like this.
After reading a bit about Application.Volatile method, It calculated the entire sheet when ever there is a change in any cell. I figured that should I pass every cell value used in this function as an argument in order to avoid the use of volatile method, which defeats my purpose of writing the macro. Can some one please help me out how I could make this work other than re-writing the macro with all the arguments.
Function Service_Volume(rn As Range, YPeriod As String) As Long
'Macro written by V.V.
'Yperiod is the analysis Term (E Existing,M Mid-Term,L Long-Term)
Dim TPeriod As String
Dim F_T As String
Dim Lookup_Rn As Range
Dim Column_Lookup As Integer
Dim LOS_Standard As String
Dim i As Integer
On Error GoTo Line1
i = rn.Row
Set Lookup_Rn = Sheets("GSV_Database").Range("C:V")
'temporary refernce to the Time period of analysis needs to be updated
TPeriod = ActiveSheet.Cells(4, 33) ' Time period of analysis
F_T = Facility(rn, YPeriod)
'Check for LOS standard with respect to the analysis term
If (YPeriod = "E") Then
LOS_Standard = Cells(i, 18)
ElseIf (YPeriod = "M") Then
LOS_Standard = Cells(i, 36)
ElseIf (YPeriod = "L") Then
LOS_Standard = Cells(i, 43)
End If
'Service volume lookup with respect to the time period of analysis
Select Case TPeriod
Case "DAILY":
If LOS_Standard = "A" Then
Column_Lookup = 4
ElseIf LOS_Standard = "B" Then
Column_Lookup = 5
ElseIf LOS_Standard = "C" Then
Column_Lookup = 6
ElseIf LOS_Standard = "D" Then
Column_Lookup = 7
ElseIf LOS_Standard = "E" Then
Column_Lookup = 8
End If
Service_Volume = WorksheetFunction.VLookup(F_T, Lookup_Rn, Column_Lookup, False)
Case "PEAK HOUR TWO-WAY":
If LOS_Standard = "A" Then
Column_Lookup = 10
ElseIf LOS_Standard = "B" Then
Column_Lookup = 11
ElseIf LOS_Standard = "C" Then
Column_Lookup = 12
ElseIf LOS_Standard = "D" Then
Column_Lookup = 13
ElseIf LOS_Standard = "E" Then
Column_Lookup = 14
End If
Service_Volume = WorksheetFunction.VLookup(F_T, Lookup_Rn, Column_Lookup, False)
Case "PEAK HOUR PEAK DIRECTION":
If LOS_Standard = "A" Then
Column_Lookup = 16
ElseIf LOS_Standard = "B" Then
Column_Lookup = 17
ElseIf LOS_Standard = "C" Then
Column_Lookup = 18
ElseIf LOS_Standard = "D" Then
Column_Lookup = 19
ElseIf LOS_Standard = "E" Then
Column_Lookup = 20
End If
Service_Volume = WorksheetFunction.VLookup(F_T, Lookup_Rn, Column_Lookup, False)
End Select
Exit Function
Line1:
MsgBox Error.Description
End Function
Function Class(rn As Range) As String
'Marco used to determine the class of roadway segment V.V
Dim Cl As Variant
Dim i As Integer
i = rn.Row
Dim At As String
At = Cells(i, 17) ' Arterial type (Highway, Freeway, Arterial..)
Cl = Cells(i, 22) ' Signal Density of the roadway segment
If (At = "F") Then
Class = "F"
ElseIf (Cl < 2) And Cl <> 0 Then Class = 1
ElseIf (Cl >= 2 And Cl <= 4.5) Then Class = 2
ElseIf Cl = 0 Then
Class = 0
Else: Class = 3
End If
End Function
Function Facility_Type(rn As Range) As String
' MACRO used to determine the facility type of the roadwaysegment V.V
Dim i As Integer
i = rn.Row
Dim Area As String
Area = Cells(i, 16) ' Existing area type , the area type remains constant irrepective of the analysis period
Dim Fac_Type As String
Dim Clas As String
Clas = Class(rn)
If Clas = "F" Then
Fac_Type = "FW"
ElseIf (Area = "UA" Or Area = "TA") And Clas <> 0 Then
Fac_Type = "S2WAC" & Clas
ElseIf (Area = "UA" Or Area = "TA") And Clas = 0 Then
Fac_Type = "UFH"
ElseIf (Area = "RUA" Or Area = "RDA") And Clas <> 0 Then
Fac_Type = "IFH"
ElseIf (Area = "RUA" Or Area = "RDA") And Clas = 0 Then
Fac_Type = "UFH"
End If
Facility_Type = Fac_Type
End Function
Function Facility(rn As Range, Period As String) As String
' MACRO used to determine the facility Code to lookup Service Volumes of the roadwaysegment V.V
Dim i As Integer
Dim Area As String ' Area Type
Dim Fac_Type As String ' Facility type parameter
Dim One_Two As String ' one way two parameter
Dim ELanes As Integer
Dim MLanes As Integer
Dim LLanes As Integer
Dim DU As String ' divided undivided parameter
Dim Left As String ' left turn lanes parameter
Dim right As String ' right turn lanes parameter
i = rn.Row
Fac_Type = Facility_Type(rn)
Area = Cells(i, 16).Value
One_Two = Cells(i, 25).Value
DU = Cells(i, 24).Value
If (DU = "1W") Then
DU = "U"
Else: DU = DU
End If
Select Case Period
Case "E":
'Existing Period of analysis
ELanes = Cells(i, 28).Value 'Existing number of lanes
'Check for One way facility
' If (DU = "1W") Then
' DU = "U"
' End If
'Check for DU with lanes more than two
If ((ELanes >= 2) And One_Two <> "1W" And DU = "D") Then
Left = "WL"
Else
Left = Cells(i, 26).Value 'exisitng left turn lanes information
End If
right = Cells(i, 27).Value ' existing right turn lanes information
If Fac_Type = "FW" Then
Facility = Area & "_" & Fac_Type & "_" & ELanes & "L_" & right
Else
Facility = Area & "_" & Fac_Type & "_" & One_Two & "_" & ELanes & "L_" & DU & "_" & Left & "_" & right
End If
Case "M":
ELanes = Cells(i, 28).Value ' existing lane information
MLanes = Cells(i, 35).Value ' E+C (Mid-Term) lane information
'Check for DU with lanes more than existing conditions
If ((MLanes - ELanes) <> 0 And DU <> "1W" And DU <> "D") Then
DU = "D"
End If
'Check for Left turn parameter if the future number of lanes in more than two and is not one way street, by default the left
'turn lanes should be considered
If ((MLanes >= 2) And One_Two <> "1W" And DU = "D") Then
Left = "WL"
Else
Left = Cells(i, 38).Value ' Future Left Turn bay information
End If
right = Cells(i, 39).Value ' Future Right Turn bay information
'Facility code for E+C conditions
If Fac_Type = "FW" Then
Facility = Area & "_" & Fac_Type & "_" & MLanes & "L_" & right
Else
Facility = Area & "_" & Fac_Type & "_" & One_Two & "_" & MLanes & "L_" & DU & "_" & Left & "_" & right
End If
Case "L":
ELanes = Cells(i, 28).Value ' Existing number of Lanes
LLanes = Cells(i, 42).Value ' Long range number of lanes
'Check for DU with lanes more than existing conditions
If ((LLanes - ELanes) >= 2 And DU <> "1W" And DU <> "D") Then
DU = "D"
End If
If ((LLanes >= 2) And One_Two <> "1W" And DU = "D") Then
Left = "WL"
Else
Left = Cells(i, 45).Value ' Future Left Turn bay information
End If
right = Cells(i, 46).Value ' Future Right Turn bay information
'Facitlity code for Long term
If Fac_Type = "FW" Then
Facility = Area & "_" & Fac_Type & "_" & LLanes & "L_" & right
Else
Facility = Area & "_" & Fac_Type & "_" & One_Two & "_" & LLanes & "L_" & DU & "_" & Left & "_" & right
End If
End Select
End Function
Thank you