Replicate Excel 2016's SWITCH function in VBA UDF

[freelensia]

Hi,

Excel 2016 rolled out many new functions such as SWITCH, TEXTJOIN, etc. Unfortunately, these functions are not available for non-365 subscribers.

I was wondering if somebody built a VBA UDF for SWITCH already? Its syntax is the following:

[FONT=wf_segoe-ui_normal]Syntax[/FONT]
[FONT=wf_segoe-ui_normal]SWITCH(expression, value1, result1, [default or value2, result2],…[default or value3, result3])[/FONT]

[FONT=wf_segoe-ui_semibold][FONT=wf_segoe-ui_normal]Argument[/FONT][/FONT]	[FONT=wf_segoe-ui_semibold][FONT=wf_segoe-ui_normal]Description[/FONT][/FONT]
[FONT=wf_segoe-ui_normal]expression (required)[/FONT]	[FONT=wf_segoe-ui_normal]Expression is the value (such as a number, date or some text) that will be compared against value1…value126.[/FONT]
[FONT=wf_segoe-ui_normal]value1…value126 [/FONT]	[FONT=wf_segoe-ui_normal]ValueN is a value that will be compared against expression.[/FONT]
[FONT=wf_segoe-ui_normal]result1…result126 [/FONT]	[FONT=wf_segoe-ui_normal]ResultN is the value to be returned when the corresponding valueN argument matches expression. ResultN and must be supplied for each corresponding valueN argument.[/FONT]
[FONT=wf_segoe-ui_normal]default (optional)[/FONT]	[FONT=wf_segoe-ui_normal]Default is the value to return in case no matches are found in the valueN expressions. The Default argument is identified by having no corresponding resultN expression (see examples). Default must be the final argument in the function.[/FONT]

<thead style="box-sizing: border-box;">
</thead><tbody style="box-sizing: border-box;">
</tbody>

[FONT=wf_segoe-ui_normal]Because functions are limited to 254 arguments, you can use up to 126 pairs of value and result arguments.[/FONT]

I imagine you would use Case select. However the problem is how the recognize the last input variable as the default output and return it in the right scenario.

Anybody has some sample (incomplete is fine) that could get me started?

Thanks!

 

[pvr928]

Hi freelensia

Try this UDF out.

It takes two arguments, arg and rRange; both are required.

arg is the expression in the MS documentation and requires a single integer.
rRange is a two dimensional range (r x c) with the left column containing value1, value2, etc and the right column containing result1, result2, etc.

If the bottom value is blank, but the bottom result contains a string, if there is no match, this string will be returned - as how I believe the SWITCH() function works.

If there is no default option, if there is no match, the UDF returns "No Match".

Function SWITCH_UDF(arg As Integer, rRange As Range)
Dim aDataArray()
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim i As Integer
Dim key As Variant
Dim bOption As Boolean
aDataArray = rRange
For i = 1 To UBound(aDataArray, 1)
    dict(aDataArray(i, 1)) = aDataArray(i, 2)
Next i
bOption = False
If IsEmpty(aDataArray(UBound(aDataArray, 1), 1)) Then bOption = True
For Each key In dict
    If dict.Exists(arg) Then
        SWITCH_UDF = dict(arg)
    
    Else
    
        If bOption = True Then
        
            SWITCH_UDF = aDataArray(UBound(aDataArray, 1), 2)
            
        Else
            SWITCH_UDF = "No Match"
            
        End If
    
    End If
    
Next
End Function

Cheers

pvr928

 

[freelensia]

Hi pvr928,

Thanks for the prompt reply

I tried your code and it worked as you intended.

However this UDF is quite different from SWITCH()'s true behavior.

First of all Switch can evaluate any type of text, not just integer (in your case I believe is the arg variable)
Secondly Switch conducts the evaluation in pairs of variables. They don't have to stick together in array format. Like this:

=SWITCH(A1, "car", "four wheels", "bike", "two wheels", "vehicle type not in database")

As you can see the 2nd, 3rd, 4th and 5th inputs are separate values. They can actually be references to cells laying on different sheets.

Any further thoughts on the problem?

Freelensia

 

[Norie]

Why not use CHOOSE/MATCH, with a little bit of IFERROR?

=IFERROR(CHOOSE(MATCH(A1, {"Car","Bike"},0), "Four wheels", "Two Wheels"), "Vehicle not in database")

PS I use Excel 2016 and it doesn't have a SWITCH function.

 

[freelensia]

Hi finally tried this function and it worked as intended. It will take any type of inputs (texts, cells, range of cells, arrays, etc.)

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Public Function TJoin(Sep As String, ParamArray TxtRng() As Variant) As String
On Error Resume Next
'Sep is the separator, set to "" if you don't want any separator. Separator must be string or single cell, not cell range
'TxtRng is the content you want to join. TxtRng can be string, single cell, cell range or array returned from an array function. Empty content will be ignored
Dim OutStr As String 'the output string
Dim i, j, k, l As Integer 'counters
Dim FinArr(), element As Variant 'the final array and a temporary element when transfering between the two arrays

'Go through each item of TxtRng(), depending on the item type, transform and put it into FinArray()
i = 0 'the counter for TxtRng
j = 0 'the counter for FinArr
k = 0: l = 0 'the counters for the case of array from Excel array formula
Do While i < UBound(TxtRng) + 1
If TypeName(TxtRng(i)) = "String" Then 'specified string like "t"
ReDim Preserve FinArr(0 To j)
FinArr(j) = "blah"
FinArr(j) = TxtRng(i)
j = j + 1
ElseIf TypeName(TxtRng(i)) = "Range" Then 'single cell or range of cell like A1, A1:A2
For Each element In TxtRng(i)
ReDim Preserve FinArr(0 To j)
FinArr(j) = element
j = j + 1
Next
ElseIf TypeName(TxtRng(i)) = "Variant()" Then 'array returned from an Excel array formula
For k = LBound(TxtRng(0), 1) To UBound(TxtRng(0), 1)
For l = LBound(TxtRng(0), 2) To UBound(TxtRng(0), 2)
ReDim Preserve FinArr(0 To j)
FinArr(j) = TxtRng(0)(k, l)
j = j + 1
Next
Next
Else
TJoin = CVErr(xlErrValue)
Exit Function
End If
i = i + 1
Loop

'Put each element of the new array into the join string
For i = LBound(FinArr) To UBound(FinArr)
If FinArr(i) <> "" Then 'Remove this line if you want to include empty strings
OutStr = OutStr & FinArr(i) & Sep
End If
Next
TJoin = Left(OutStr, Len(OutStr) - Len(Sep)) 'remove the ending separator

End Function</code>
---------
Freelensia
オンラインで通訳者を予約する