How to get results based on multiple selection from the list box in excel using VBA?

Question

What I want to accomplish is:

When I select more than one type of discount in cell D2 (Note: Cell D2 has a macro that allows me to select more than one choice from the dropdown and separates the two choices by a comma), I want to get the product of their corresponding values in cell E2. In this case, since I have selected "Student" and "Veteran", i get multiple of 0.5 and 0.03 = 0.15 in cell E2.

Since, I have multiple discount types, a simple if statement won't do because I may select more than two discount at a time and in any order. Please help as I am very new to VBA. Thanks!

Here is the code that I am using for multiple selection from the dropdown list box. Note: I copied this code from online.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Oldvalue As String
  Dim Newvalue As String

  Application.EnableEvents = True

  On Error GoTo Exitsub

  If Not Intersect(Target, Columns(4)) Is Nothing Then
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
      GoTo Exitsub
    Else: If Target.Value = "" Then GoTo Exitsub Else
      Application.EnableEvents = False
      Newvalue = Target.Value
      Application.Undo

      Oldvalue = Target.Value

      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
          Target.Value = Oldvalue & ", " & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If

Application.EnableEvents = True

Exitsub:

Application.EnableEvents = True

End Sub

Answer 1

If you have the Excel 365, this can be easily done with a Formula, using FILTERXML and a Spill range

=PRODUCT(XLOOKUP(FILTERXML("<a><s>"&SUBSTITUTE(E2,",","</s><s>")&"</s></a>","//s"),A:A,B:B,0,0))

---

Alternativly, a UDF (does not require Excel 365)

Function NetDiscount(LookupItems As Variant, Discounts As Range, Optional Seperator As String = ",") As Variant
    Dim LookupArray() As String
    Dim LookupItem As Variant
    Dim idx As Variant
    Dim Discount As Double
    Dim OneOrMoreFound As Boolean
    
    LookupArray = Split(LookupItems, Seperator)
    Discount = 1#
    For Each LookupItem In LookupArray
        idx = Application.Match(LookupItem, Discounts.Columns(1), 0)
        If Not IsError(idx) Then
            OneOrMoreFound = True
            Discount = Discount * Discounts.Cells(idx, 2).Value2
        End If
    Next
    If Not OneOrMoreFound Then
        ' Return default value if no items found
        Discount = 0#
    End If
    NetDiscount = Discount
End Function

---

Not related to your question, but there is a major bug in your Event code: if your "Discount Type" list includes an item that is contained in another item (eg "Citizen" and Senior Citizen", and the longer item is already selected, then your code won't add the shorter one because If InStr(1, Oldvalue, Newvalue) = 0 Then will find the shorter value within the longer one.

Here's a refactored version, addressing this and other style issues

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim OldValue As String
    Dim NewValue As String
    Dim Seperator As String
    Dim CombinedValue As String
    On Error GoTo ExitSub
    
    If Target.Count > 1 Then GoTo ExitSub
    If Target.Value = vbNullString Then GoTo ExitSub
    If Not Intersect(Target, Me.Columns(4)) Is Nothing Then
        If Not Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            Application.EnableEvents = False
            Seperator = ", "
            NewValue = Target.Value
            Application.Undo
            OldValue = Target.Value
            
            If OldValue = vbNullString Then
                CombinedValue = Seperator & NewValue
            Else
                OldValue = Seperator & OldValue
                NewValue = Seperator & NewValue
                If InStr(1, OldValue, NewValue) = 0 Then
                    CombinedValue = OldValue & NewValue
                Else
                    CombinedValue = OldValue
                End If
            End If
            Target.Value = Mid$(CombinedValue, Len(Seperator) + 1)
        End If
    End If
    
ExitSub:
    Application.EnableEvents = True
End Sub