Help with VBA code

LordSnow548

Banned user
Joined
Apr 29, 2020
Messages
16
Office Version
  1. 365
Platform
  1. Windows
Hi guys,

Thanks for taking the time to look over this for me, i have the below VBA code that works well when implemented as needed, however im now making changes from feedback ive received and im looking for help to make it work better.

In a nutshell the below code allows me to select multiple items from a validation list, and then does a Vlookup and returns the result in a textbox. What i need it to now do is allow me to select items from 4 data validation lists and then do the vlookup and return the results in the textbox.

The below is what i have thus far in terms of the sheet etc below each of the headings is a data validation list, of which there items you can select below this is an activex textbox named textbox 1 this is where the results will populate when the items are selected from each drop down. (i hope this is making sense)

1693486043540.png


The below is the VBA code i have presently in its entirety,

VBA Code:
Option Explicit

Const DELIM As String = " | "

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim oldValue As String, newValue As String, sep As String
    Dim arr() As String, s As String, el, remove As Boolean
    
    If Target.CountLarge > 1 Then Exit Sub
    
    newValue = Target.Value
    
    On Error GoTo exitError
    
    Select Case Target.Address(False, False)
        Case "B12"
            If Not HasListValidation(Target) Then Exit Sub
            If Len(newValue) > 0 Then 'check cell was not cleared
                Application.EnableEvents = False
                Application.Undo
                oldValue = Target.Value
                If Len(oldValue) > 0 Then
                    arr = Split(oldValue, DELIM)
                    For Each el In arr
                        If el = newValue Then
                            remove = True 'remove if re-selected
                        Else
                            s = s & sep & el 'else add to cell content
                            sep = DELIM
                        End If
                    Next el
                    If Not remove Then s = s & sep & newValue 'add if not a re-selection
                    Target.Value = s
                Else
                    Target.Value = newValue
                End If
            End If
            Me.Range("B13").Value = MultiLookup(Target.Value) 'perform the lookups and populate (eg) to the next cell
            Me.OLEObjects("TextBox1").Object.Value = MultiLookup(Target.Value) 'or add to textbox
       Case "C3"
            Select Case newValue
                Case "Solutions"
                    MsgBox "YOU HAVE SELECTED: SOLUTIONS POLICY - NO NCD CHECK REQUIRED"
                Case "H/Sol"
                    MsgBox "YOU HAVE SELECTED HEALTHIER SOLUTIONS POLICY - CHECK THE NCD IN UNO AND ACPM"
            End Select     'C3 values
        Case "E3"
            Select Case newValue
                Case "NMORI", "CMORI"
                    MsgBox newValue & " - FULL HISTORY TO BE TAKEN - USE STEP 2 TO HELP" & _
                                     " YOU DETERMINE IF THE SYMPTOMS ARE PRE-EXISTING"
                Case "CMORI"
                    MsgBox "CMORI - FULL HISTORY TO BE TAKEN - USE STEP 2 TO HELP YOU " & _
                            "DETERMINE IF THE SYMPTOMS ARE PRE-EXISTING"
                Case "CME"
                    MsgBox "CME - CHECK IF THE SYMPTOMS ARE RELATED TO ANY EXCLUSIONS" & _
                           " IF NOT RELATED TREAT AS MHD"
                Case "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 "MHD"
                    MsgBox "MHD - TAKE BRIEF HISTORY ONLY"
            End Select    'E3 values
        Case Else
            Exit Sub
        
    End Select            'Target address
    
exitError:
  Application.EnableEvents = True
End Sub

'Given input `txt` containing zero or more DELIM-separated values,
'  perform a lookup on each value, and return all of the results in
'  a single string
'  Returns "?value?" for any term not matched in the vlookup
Function MultiLookup(txt As String)
    Dim arr, el, s As String, res, sep As String
    If Len(txt) > 0 Then
        arr = Split(txt, DELIM)
        For Each el In arr
            res = Application.VLookup(el, ThisWorkbook.Sheets("Sheet2").Range("A1:B23"), 2, False)
            If IsError(res) Then res = "?" & el & "?"
            s = s & sep & res
            sep = vblf & vblf '## use different delimiter for the output
        Next el
    End If
    MultiLookup = s
End Function


'does a cell have list validation applied?
Public Function HasListValidation(c As Range) As Boolean
    On Error Resume Next 'ignore error if no validation on cell
    HasListValidation = (c.Validation.Type = 3)
End Function

Thanks in advance to any one who can solve this quandary for me
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

Forum statistics

Threads
1,215,072
Messages
6,122,968
Members
449,095
Latest member
Mr Hughes

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top