I’ve made a sample function which calculates cartage based on country and weight, and I would like the country to appear as a drop-down list. It’s like what you can see when using Subtotal
function, so users can select from when they entering the formula in cells.
I have referred to this question and answer: VBA Function argument list select
The function worked only if the reference number of enumeration entered as the first argument, and it’s not taking cell value.
May I ask:
-
Is it possible the enumeration descriptive value be shown as a drop-down list like the
Subtotal
function? -
Is it possible the first argument take value from the cell as per users assigned?
Here is sample code:
Option Explicit
Public Enum nations
USA = 1
AU = 2
CN = 3
SG = 4
End Enum
Function intlCartage(country As nations, weight As Double)
Select Case country
Case nations.AU
intlCartage = 15 + WorksheetFunction.RoundUp((weight - 1), 0) * 10
Case nations.CN
intlCartage = 20 + WorksheetFunction.RoundUp((weight - 1), 0) * 5
Case nations.SG
intlCartage = 15 + WorksheetFunction.RoundUp((weight - 1), 0) * 10
Case nations.USA
intlCartage = 10 + WorksheetFunction.RoundUp((weight - 1), 0) * 8
Case Else
intlCartage = "please contact sales for quote."
End Select
End Function
Is it possible the enumeration descriptive value be shown as a drop-down list like the Subtotal function?
I don’t believe so, at least on my experience. This does tie into your next question.
Is it possible the first argument take a value from the cell as per users assigned?
Use Data>Data Tools>Data Validation>Data Validation (keyboard shortcut = Alt,D,L) and have the values USA,AU,CN,SG
as the list of available options. You’d then need a string to enumeration converter to do the automatic conversion for you.
I just tested and came up with the same values using both. I left a call to your original intlCartage
to help show that it is passing an enumeration in.
'Standard Module
Public Function updatedCartage(ByVal country As String, ByVal weight As Double) As Variant
Dim enumCountry As nations
Dim nationConverter As NationsConverter
Set nationConverter = New NationsConverter
enumCountry = nationConverter.ToEnum(country)
updatedCartage = intlCartage(enumCountry, weight)
End Function
You’ll put this code in a class module. I’ve renamed mine to NationsConverter
as Class1
isn’t descriptive, at all.
'For Early binding set a reference to
'Tools>References> "Microsoft Scripting Runtime"
'then use Scripting.Dictionary instead of Object.
'You'd then change where you set the variable to
'New Scripting.Dictionary from CreateObject()
Private StringForEnum As Object
Private EnumForString As Object
Private Sub Class_Initialize()
PopulateDictionaries
End Sub
Private Sub PopulateDictionaries()
Set EnumForString = CreateObject("Scripting.Dictionary")
EnumForString.Add "USA", nations.USA
EnumForString.Add "AU", nations.AU
EnumForString.Add "CN", nations.CN
EnumForString.Add "SG", nations.SG
Set StringForEnum = CreateObject("Scripting.Dictionary")
Dim element As Variant
For Each element In EnumForString.Keys
StringForEnum.Add EnumForString.Item(element), element
Next
End Sub
Public Function ToEnum(ByVal value As String) As nations
value = UCase$(value)
If Not EnumForString.Exists(value) Then
ThrowInvalidArgument "ToEnum", value
End If
ToEnum = EnumForString(value)
End Function
Public Function ToString(ByVal value As nations)
If Not StringForEnum.Exists(value) Then
ThrowInvalidArgument "ToString", CStr(value)
End If
ToString = StringForEnum(value)
End Function
Private Sub ThrowInvalidArgument(ByVal source As String, ByVal value As String)
Err.Raise 5, Information.TypeName(Me) & "." & source, "Invalid input '" & value & "' was supplied."
End Sub
Public Property Get Enums() As Variant
Enums = EnumForString.Items
End Property
Public Property Get Strings() As Variant
Strings = EnumForString.Keys
End Property
Answer:
Your options are limited. I know of three ways and none of them are good:
Application.MacroOptions
Add a method like this to your code and run it once
Sub RegisterFunctions()
Application.MacroOptions "intlCartage", "USA = 1" & vbCrLf & _
"AU = 2" & vbCrLf & _
"CN = 3" & vbCrLf & _
"SG = 4"
End Sub
If you enter a formula like =intlCartage(
and press Ctrl–A you’ll get the description text in the Function help. Limited space and not very helpful. There is a tempting parameter in the MacroOptions defintion called MenuText – but it is ignored.
The very complicated solution
Read more here: The quest for the Excel custom function tooltip
Data validation
Use the built-in data validation functions in an adjacent cell.
Answer:
This way uses named ranges and comes from the accepted answer on this link.
The Add_Enums
procedure only needs to be executed once and then you get a type of drop-down when you enter the formula (although enter “U” as the first letter also offers the UPPER function as a suggestion).
Public Sub Add_Enums()
Dim CountryCode As Collection
Dim Country As Variant
Set CountryCode = New Collection
With CountryCode
.Add Array("USA", 1)
.Add Array("AU", 2)
.Add Array("CN", 3)
.Add Array("SG", 4)
End With
For Each Country In CountryCode
AllocateNamedRange CStr(Country(0)), CStr(Country(1))
Next Country
End Sub
Public Function intlCartage(Country As String, weight As Double) As Variant
Dim lAddition As Long
Dim lMultiplier As Long
Select Case Country
Case 1 'USA
lAddition = 10
lMultiplier = 8
Case 2, 4 'AU or SG
lAddition = 15
lMultiplier = 10
Case 3 'CN
lAddition = 20
lMultiplier = 5
Case Else
intlCartage = CVErr(xlErrNA)
End Select
If IsError(intlCartage) Then
'Do nothing, it already holds an error.
Else
intlCartage = lAddition + WorksheetFunction.Round((weight - 1), 0) * lMultiplier
End If
End Function
Public Function NamedRangeExists(Book As Workbook, sName As String) As Boolean
On Error Resume Next
NamedRangeExists = Book.Names(sName).Index <> (Err.Number = 0)
On Error GoTo 0
End Function
Public Sub AllocateNamedRange(sName As String, sRefersTo As String, Optional ReferType = "R1C1", _
Optional Book As Workbook)
If Book Is Nothing Then
Set Book = ThisWorkbook
End If
With Book
If NamedRangeExists(Book, sName) Then .Names(sName).Delete
If ReferType = "R1C1" Then
.Names.Add Name:=sName, RefersToR1C1:=sRefersTo
ElseIf ReferType = "A1" Then
.Names.Add Name:=sName, RefersTo:=sRefersTo
End If
End With
End Sub
Tags: excelexcel, function, list, select, vba