Userform to search for exact and partial values from a Combobox in the database worksheet

Below is my current code. The strFind1 searches for a name within the database and then I need strFind2 to do a exact for a Subproject search and a partial search for everything containing the Subproject selected and other Subprojects. Currently, when the database entry in the worksheet includes Subproject 1 the search function works but when I have an entry that contains Subproject 1/Subproject 4 it does not find the entry. How can I expand the strFind2 to equal what is selected in the Combobox2 and find entries that have what is selected plus more text. I have set the line where I think everything is going wrong to a bold format. I would greatly appreciate someones help, I am sure it is a quick fix! Please let me know if I need to provide further clarification.

Option Explicit

'Module Level Variables
Dim rRange As Range
Dim strFind1 As String
Dim strFind2 As String
Dim strFind3 As String
Dim strFind4 As String

Private Sub ComboBox1_Change()
'Pass chosen value to String variable strFind1
strFind1 = ComboBox1
'Enable ComboBox2 only if value is chosen
ComboBox2.Enabled = Not strFind1 = vbNullString
End Sub
Private Sub ComboBox2_Change()
'Pass chosen value to String variable strFind1
strFind2 = ComboBox2'Enable ComboBox3 only if value is chosen
ComboBox3.Enabled = Not strFind2 = vbNullString
End Sub

Private Sub ComboBox3_Change()
'Pass chosen value to String variable strFind1
strFind3 = ComboBox3
'Enable ComboBox4 only if value is chosen
ComboBox4.Enabled = Not strFind3 = vbNullString
End Sub

Private Sub ComboBox4_Change()
'Pass chosen value to String variable strFind1
strFind4 = ComboBox4
ComboBox4.Value = Format(ComboBox4.Text, "mm/dd/yyyy")

End Sub

Private Sub CommandButton1_Click()
Worksheets("Travel").Activate
'Procedure level variables
Dim lCount As Long
Dim lOccur As Long
Dim rCell As Range
Dim rCell2 As Range
Dim rCell3 As Range
Dim rCell4 As Range

Dim bFound As Boolean

'At least one value, from ComboBox1 must be chosen
If strFind1 & strFind2 & strFind3 & strFind4 = vbNullString Then
   MsgBox "No items to find chosen", vbCritical
   Exit Sub 'Go no further
ElseIf strFind1 = vbNullString Then
   MsgBox "A value from " & Label1.Caption _
   & " must be chosen", vbCritical
   Exit Sub 'Go no further
End If

'Clear any old entries
On Error Resume Next
ListBox1.Clear
On Error GoTo 0

'If String variable are empty pass the wildcard character
If strFind2 = vbNullString Then strFind2 = "*"
If strFind3 = vbNullString Then strFind3 = "*"
If strFind4 = vbNullString Then strFind4 = "*"

'Set range variable to first cell in table.
Set rCell = rRange.Cells(4, 4)
'Pass the number of times strFind1 occurs
lOccur = WorksheetFunction.CountIf(rRange.Columns(4), strFind1)

'Loop only as many times as strFind1 occurs
For lCount = 1 To lOccur
'Set the range variable to the found cell. This is then also _
 used to start the next Find from (After:=rCell)
    Set rCell = rRange.Columns(4).Find(What:=strFind1, After:=rCell, _
              LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
              SearchDirection:=xlNext, MatchCase:=False)
    'Check each find to see if strFind2 and strFind3 occur _
     on the same row.
    If rCell(1, 3) Like strFind2 And rCell(1, 4) Like strFind3 And rCell(1, 5) Like strFind4 Then
       bFound = True 'Used to not show message box for no value found.
       'Add the address of the found cell and the cell on the _
        same row but 2 columns to the right.
       ListBox1.AddItem rCell.Address & ":" & rCell(1, 13).Address
    End If
Next lCount

If bFound = False Then 'No match
 MsgBox "Sorry, no matches", vbOKOnly
End If
End Sub

Private Sub CommandButton2_Click()
'Close UserForm
Unload Me
End Sub

Private Sub Frame1_Click()

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Check for range addresses
If ListBox1.ListCount = 0 Then Exit Sub
'GoTo doubled clicked address
Application.Goto Range(ListBox1.Text), True
End Sub

Private Sub UserForm_Initialize()
Worksheets("Travel").Activate
'Procedure level module
Dim lRows As Long

'Set Module level range variable to CurrentRegion _
 of the Selection
Set rRange = Selection.CurrentRegion
    If rRange.Rows.Count < 2 Then ' Only 1 row
       MsgBox "Please select any cell in your table first", vbCritical
       Unload Me 'Close Userform
       Exit Sub
    Else

    With rRange
    'Set Label Captions to the Table headings
        Label1.Caption = .Cells(3, 4)
        Label2.Caption = .Cells(3, 6)
        Label3.Caption = .Cells(3, 7)
        Label4.Caption = .Cells(3, 8)
        
        'Set RowSource of ComboBoxes to the appropriate columns _
         inside the table
        ComboBox1.RowSource = .Columns(4).Offset(4, 0).Address
        ComboBox2.AddItem "Subproject 1"
        ComboBox2.AddItem "Subproject 2"
        ComboBox2.AddItem "Subproject 3"
        ComboBox2.AddItem "Subproject 4"
        ComboBox2.AddItem "Subproject 5"
        ComboBox2.AddItem "Subproject 6"
        ComboBox2.AddItem "GI"
        ComboBox2.AddItem "CoFisOps"
        ComboBox2.AddItem "All"
        ComboBox3.AddItem "Argentina"
        ComboBox3.AddItem "Australia"
        ComboBox3.AddItem "Austria"
        ComboBox3.AddItem "Brazil"
        ComboBox3.AddItem "Canada"
        ComboBox3.AddItem "Central Europe"
        ComboBox3.AddItem "France"
        ComboBox3.AddItem "Germany"
        ComboBox3.AddItem "Italy"
        ComboBox3.AddItem "Japan"
        ComboBox3.AddItem "Korea"
        ComboBox3.AddItem "Malaysia"
        ComboBox3.AddItem "Mexico"
        ComboBox3.AddItem "New Zealand"
        ComboBox3.AddItem "Portugal"
        ComboBox3.AddItem "Russia"
        ComboBox3.AddItem "Spain"
        ComboBox3.AddItem "United Kingdom"
        ComboBox3.AddItem "United States"
        ComboBox3.AddItem "All"
        ComboBox4.RowSource = .Columns(8).Offset(4, 0).Address
    End With
    End If
End Sub

Private Sub UserForm_Terminate()
Worksheets("Travel").Activate
'Destroy Module level variables
Set rRange = Nothing
strFind1 = vbNullString
strFind2 = vbNullString
strFind3 = vbNullString
strFind4 = vbNullString
End Sub

Code Tags Added
Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



(I have added them for you today. Please read all Forum Rules and comply in the future.)

Check out my new databaseform