Home » excel » excel – make VBA function argument a list for user to select from

excel – make VBA function argument a list for user to select from

Posted by: admin April 23, 2020 Leave a comment

Questions:

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:

  1. Is it possible the enumeration descriptive value be shown as a drop-down list like the Subtotal function?

  2. 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
How to&Answers:

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 CtrlA 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