Vlookup from multiselect data validation list

[JackReacher85]

Hi guys,

I am working on a project for my work which is a form that users can use to help them make decisions etc.

I have this code that provides the ability to make multiple selections from a data validation list, so instead of the default excel position of being able to select one option only the below allows me to select multiple options, within this is code that throws a pop message when a certain item in a data validation list is selected.

Private Sub Worksheet_Change(ByVal Destination As Range)
  Dim rngDropdown As Range
  Dim oldValue As String
  Dim newValue As String
  Dim DelimiterType As String
  DelimiterType = " | "
  Dim DelimiterCount As Integer
  Dim TargetType As Integer
  Dim i As Integer
  Dim arr() As String
  
  If Destination.Count > 1 Then Exit Sub
  On Error Resume Next
  
  Set rngDropdown = Cells.SpecialCells(xlCellTypeAllValidation)
  On Error GoTo exitError
  
  If rngDropdown Is Nothing Then GoTo exitError
  
  If Not Intersect(Destination, Range("C25")) Is Nothing Then
    TargetType = 0
    TargetType = Destination.Validation.Type
    If TargetType = 3 Then  ' is validation type is "list"
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        newValue = Destination.Value
        Application.Undo
        oldValue = Destination.Value
        Destination.Value = newValue
        If oldValue <> "" Then
            If newValue <> "" Then
                If oldValue = newValue Or oldValue = newValue & Replace(DelimiterType, " ", "") Or oldValue = newValue & DelimiterType Then ' leave the value if there is only one in the list
                    oldValue = Replace(oldValue, DelimiterType, "")
                    oldValue = Replace(oldValue, Replace(DelimiterType, " ", ""), "")
                    Destination.Value = oldValue
                ElseIf InStr(1, oldValue, DelimiterType & newValue) Then
                    arr = Split(oldValue, DelimiterType)
                If Not IsError(Application.Match(newValue, arr, 0)) = 0 Then
                    Destination.Value = oldValue & DelimiterType & newValue
                        Else:
                    Destination.Value = ""
                    For i = 0 To UBound(arr)
                    If arr(i) <> newValue Then
                        Destination.Value = Destination.Value & arr(i) & DelimiterType
                    End If
                    Next i
                Destination.Value = Left(Destination.Value, Len(Destination.Value) - Len(DelimiterType))
                End If
                ElseIf InStr(1, oldValue, newValue & Replace(DelimiterType, " ", "")) Then
                    oldValue = Replace(oldValue, newValue, "")
                    Destination.Value = oldValue
                Else
                    Destination.Value = oldValue & DelimiterType & newValue
                End If
                Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", "") & Replace(DelimiterType, " ", ""), Replace(DelimiterType, " ", "")) ' remove extra commas and spaces
                Destination.Value = Replace(Destination.Value, DelimiterType & Replace(DelimiterType, " ", ""), Replace(DelimiterType, " ", ""))
                If Destination.Value <> "" Then
                    If Right(Destination.Value, 2) = DelimiterType Then  ' remove delimiter at the end
                        Destination.Value = Left(Destination.Value, Len(Destination.Value) - 2)
                    End If
                End If
                If InStr(1, Destination.Value, DelimiterType) = 1 Then ' remove delimiter as first characters
                    Destination.Value = Replace(Destination.Value, DelimiterType, "", 1, 1)
                End If
                If InStr(1, Destination.Value, Replace(DelimiterType, " ", "")) = 1 Then
                    Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", ""), "", 1, 1)
                End If
                DelimiterCount = 0
                For i = 1 To Len(Destination.Value)
                    If InStr(i, Destination.Value, Replace(DelimiterType, " ", "")) Then
                        DelimiterCount = DelimiterCount + 1
                    End If
                Next i
                If DelimiterCount = 1 Then ' remove delimiter if last character
                    Destination.Value = Replace(Destination.Value, DelimiterType, "")
                    Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", ""), "")
                End If
            End If
        End If
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
  End If
 
  If Not Intersect(Destination, Range("C7")) Is Nothing Then
      Select Case Destination
          Case Is = "Solutions"
              MsgBox "YOU HAVE SELECTED: SOLUTIONS POLICY - NO NCD CHECK REQUIRED"
          Case Is = "H/Sol"
              MsgBox "YOU HAVE SELECTED HEALTHIER SOLUTIONS POLICY - CHECK THE NCD IN UNO AND ACPM"
         End Select
  End If
             
        If Not Intersect(Destination, Range("G7")) Is Nothing Then
      Select Case Destination
          Case Is = "NMORI"
              MsgBox "NMORI - FULL HISTORY TO BE TAKEN - USE STEP 2 TO HELP YOU DETERMINE IF THE SYMPTOMS ARE PRE-EXISTING"
          Case Is = "CMORI"
              MsgBox "CMORI - FULL HISTORY TO BE TAKEN - USE STEP 2 TO HELP YOU DETERMINE IF THE SYMPTOMS ARE PRE-EXISTING"
          Case Is = "CME"
              MsgBox "CME - CHECK IF THE SYMPTOMS ARE RELATED TO ANY EXCLUSIONS IF NOT RELATED TREAT AS MHD"
          Case Is = "FMU"
              MsgBox "FMU - CHECK HISTORY, CHECK IF SYMPTOMS ARE RELATED TO ANY EXCLUSIONS & CHECK IF THE SYMPTOMS REPORTED SHOULD HAVE BEEN DELCARED TO US"
          Case Is = "MHD"
        
              MsgBox "MHD - TAKE BRIEF HISTORY ONLY"
End Select
End If

exitError:
  Application.EnableEvents = True
End Sub

I have on sheet 2 range A1:B22 in column A the lookup value and then in column B the result to be displayed.

What im trying to work on is a vlookup that will look at each selected item in the drop down list, so if 4 items are selected then the vlookup looks for each item on sheet 2 within the range A1:B22 and returns the value from column 2 for each selected item in the drop down list.

So for example if the below items are selected in the drop down list

C0
NCD with XS
ERF
6 Week Option

I need a vlookup to find each item from the range A1:B22 on sheet 2 and return the value from column 2 to a specified cell, in this case Cell D25 where it can be read out like a page from a book.

I hope the above makes sense and thanks in advance for taking a look at this for me.

 

[kevin9999]

Was there nothing in this response that was of any help at all? VLookup from a multiselect data validation list

 

[Peter_SSs]

Duplicate to: VLookup from a multiselect data validation list

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread.