Excel Macro Find More Than One Condition In a Cell

'Basic Macro to find a cell containing with more than one value. Posted on StackExchange in answer to below question:
'https://stackoverflow.com/questions/45069573/how-do-i-find-a-cell-that-contains-several-values/

'I post all of my code for free and am not seeking any financial compensation. If you're
'compelled to be generous or find this helpful, please consider a tax deductible
'donation to Reason Magazine: https://reason.com/donatenow/donate.php
'Share a screenshot with me of your donation, even if just a few bucks.
'It inspires me to post more of these. My username is PGCodeRider on most social media.



    Sub FindLots()
          Dim TextArray() As String, WS As Worksheet, Targetcell As Range
          Dim Answer As String, StartingAddress As String
          Dim AllSearchText As String, QuestionHeader As String
          Dim I As Integer, t As Integer, NumericAnswer As Integer
          Dim NoMemberFound As Boolean

StartQuestion:
            If I = 0 Then
                QuestionHeader = "Enter Your Search Text"
            Else
                QuestionHeader = "Enter Your Search... part " & I + 1 & " !"

            End If

            Answer = InputBox("Add a field to search for and hit ""OK."" You will get a chance to enter search fields.", QuestionHeader, "Enter Text")

            If Answer = "" Then
              NumericAnswer = MsgBox("You didn't enter anything. Click ""Yes"" to try again. ""No"" to start search or ""Cancel"" to... cancel.", vbYesNoCancel, "Oh False!")

                If NumericAnswer = vbYes Then
                    GoTo StartQuestion
                ElseIf NumericAnswer = vbCancel Then
                    Exit Sub
                End If
            Else

                ReDim Preserve TextArray(I)
                TextArray(I) = Answer
                AllSearchText = AllSearchText & "," & Answer

                NumericAnswer = MsgBox("Would you like to add an additional members to search of """ & AllSearchText & """? Click no to continue search.", vbQuestion + vbYesNoCancel)
                    If NumericAnswer = vbYes Then
                        I = I + 1
                        GoTo StartQuestion
                    ElseIf NumericAnswer = vbCancel Then
                        Exit Sub
                    End If
            End If

            On Error Resume Next
            If TextArray(0) = "" Then
                MsgBox "No Search text entered", vbCritical
                Exit Sub
            End If
            On Error GoTo 0


        Set WS = ActiveSheet 'or whatever sheet you want to search

        Set Targetcell = WS.Cells.Find(TextArray(0), WS.Cells(1, 1))

        If Targetcell Is Nothing Then
            MsgBox "coulnd't even find " & TextArray(0), vbCritical
            Exit Sub
        ElseIf I = 0 Then
            MsgBox "Found your cell at " & Targetcell.Address
            Targetcell.Select
            Exit Sub
        End If

        StartingAddress = Targetcell.Address

        Do
        NoMemberFound = False
        For t = 1 To I

        If Targetcell.Cells.Find(TextArray(t)) Is Nothing Then
            NoMemberFound = True
            Exit For
        End If
        Next t

        If NoMemberFound = False Then
            Dim NumberOfItemsFound As Integer
                NumberOfItemsFound = NumberOfItemsFound + 1
                Dim aReply As Integer: aReply = MsgBox("Found your cell at " & Targetcell.Address & ". Keep searching?", vbYesNo, "Yea!")
                Targetcell.Select
                If Not (aReply = vbYes) Then Exit Sub

        End If

        Set Targetcell = WS.Cells.Find(TextArray(0), Targetcell)

        Loop Until Targetcell.Address = StartingAddress

        If NumberOfItemsFound > 0 Then
            MsgBox "Search completed. " & NumberOfItemsFound & " cells met your search requirement."
        Else
            MsgBox "Unable to find cells with your criteria of " & Right(AllSearchText, Len(AllSearchText) - 1), vbInformation, "Is that bad?"
        End If

        End Sub