Combining VBA Codes

[Klea]

Hello! I'm extremely new to all of this and I am trying to create a drop down menu that will allow me to make multiple selections plus show any results that contain the selected option in any way.

Klea (4).xlsm
	D
1
2	Order
3	Urine culture
4	Urine culture
5	Urine culture
6	Throat Culture
7	Throat Culture
8	HIV screen, RPR, Hep B, HepBSAg w/ Reflex confirm, GC/Chlamydia, Urine
9	HIV screen, RPR, Hep B, HepBSAg w/ Reflex confirm
10	Liver function panel
11	Celiac Disease Panel
12	SureSwab Vaginosis/Vaginitus Plus, Herpes culture
13	GC/Chlamydia, Urine, Pap Smear
14	Urine culture
15	GC/Chlamydia, Urine
16	Anemia panel, C-reactive protein, Sed Rate
17	Urine culture
18	HepBSAg w/ Reflex confirm, Hepatitis C Ab, RPR
19	Urine culture
Sheet1

Cells with Data Validation
Cell	Allow	Criteria
D1:D19	List	Urine culture,Throat Culture,HIV screen,RPR,Hep B,HepBSAg w/ Reflex confirm,GC/Chlamydia,Urine,Liver function panel,Celiac Disease Panel,SureSwab Vaginosis/Vaginitus Plus,Herpes culture,Pap Smear,Anemia panel,C-reactive protein,Sed Rate,Hepatitis C Ab

So the drop down menu is in D1. I want to be able to select "Urine" and it show me all the results that contain "Urine" whether it's by itself or with a list of other tests ran as well. I also want to be able to select "Urine", "HIV", and "Pap Smear" and have it return all valid responses to me. I also want it to be able to recognize any version of (for example) "Pap Smear", whether it was spelled with capitalization or not, etc.

Here are all the codes I have so far. However, because two of the codes are named the same thing, it does not work. How do I combine these in such a way that they still function the way I need them to. Thank you for your help!!

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("D1")) Is Nothing Then Exit Sub
    With Range("A2")
        .CurrentRegion.AutoFilter 4, "*" & Target & "*"
    End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
' To allow multiple selections in a Drop Down List in Excel (without repetition)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "$D$1" 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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("D1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, dic As Object, splt As Variant, rng As Variant
    v = Range("D3", Range("D" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v)
        If InStr(v(i, 1), ",") = 0 Then
            If Not dic.Exists(v(i, 1)) Then
                dic.Add v(i, 1), Nothing
            End If
        Else
            splt = Split(v(i, 1), ", ")
            For Each rng In splt
                If Not dic.Exists(rng) Then
                    dic.Add rng, Nothing
                End If
            Next rng
        End If
    Next i
    With Target.Validation
         .Delete
         .Add Type:=xlValidateList, Formula1:=Join(dic.keys, ",")
     End With
    Application.ScreenUpdating = True
End Sub

 

[Zot]

Not really understand precisely try this

Private Sub Worksheet_Change(ByVal Target As Range)
' To allow multiple selections in a Drop Down List in Excel (without repetition)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "$D$1" Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If Target.Value = "" Then GoTo Exitsub Else
    With Range("A2")
        .CurrentRegion.AutoFilter 4, "*" & Target & "*"
    End With
    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