Help with a code doing a double search

[ExcelGirl1988]

Hi,

I have been working on a code for my workbook that will search all the worksheets for complaints between 2 dates that the user inputs and then also searches for a keyword within the complaints so basically on the summary page the only complaints that will show will be ones logged between 2 dates that include the keyword but I have been struggling a bit with it because when I run the code it crashes my Excel, I don't know if I have made it too complicated, I might need some help to make it simpler? Any help offered would be greatly appreciated. The code I am using is below:

Sub Double_Search()
    
    Dim erow As Long, i As Long, instances As Long, lastrow As Long
    Dim myDate As Date, StartDate As Date, EndDate As Date
    Dim ws As Worksheet, wsSummary As Worksheet, sht As Worksheet
    Dim answer As VbMsgBoxResult
    Dim myString As String, firstaddress As String
    Dim c As Range
    Dim mySize As XlLookAt
    Dim found As Boolean
    
    Set wsSummary = ThisWorkbook.Worksheets("Summary")
    
    Application.ScreenUpdating = False
    
    With Worksheets("Home")
        StartDate = .Range("E5").Value
        EndDate = .Range("E6").Value
    End With
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Summary" And ws.Name <> "Home" And ws.Name <> "Data" Then
            Application.CutCopyMode = False
            For i = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
            Application.CutCopyMode = False
                myDate = ws.Cells(i, 2)
                If myDate >= StartDate And myDate <= EndDate Then
                    erow = wsSummary.Cells(wsSummary.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                    ws.Cells(i, 1).Resize(i, ws.Cells(i, ws.Columns.Count).End(xlToLeft).Column).Copy _
                    Destination:=wsSummary.Cells(erow, 1)
                    Application.CutCopyMode = False
                End If
            Next i
        End If
     Next ws
     
wsSummary.Activate
myString = Application.InputBox("Enter Keyword")
If myString = "" Then Exit Sub
If Len(myString) = 0 Then
            answer = MsgBox("The Search Field Can Not Be Left Blank" _
            & vbLf & vbLf & "Do You Want To Try Again?", vbYesNo + vbQuestion, "Search")
        Else
    If MsgBox("Exact Match Only? " & vbCrLf & vbCrLf & _
            "Yes For Exact Match Of " & myString & vbCrLf & vbCrLf & _
            "No For Any Match Of " & myString, vbYesNo + vbQuestion) = _
            vbYes Then mySize = xlWhole Else mySize = xlPart
    End If
With Worksheets("Summary").UsedRange
Set c = .Find(myString, LookIn:=xlValues, LookAt:=mySize, _
                    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then firstaddress = c.Address
found = True


Set c = .FindNext(c)
Do While c.Address <> firstaddress
Loop
End With


Set sht = ThisWorkbook.Worksheets("Home")
wsSummary.Range("A:F").RemoveDuplicates Columns:=Array(1, 3), Header:=xlYes
Application.ScreenUpdating = True


lastrow = wsSummary.Cells(Rows.Count, "A").End(xlUp).Row - 1


If lastrow = 0 Then
MsgBox "No Complaints Found", , "Search Complete"
Else
answer = MsgBox("There are " & lastrow & " complaints found" & vbNewLine & _
    "Go to Summary sheet now?", vbYesNo, "Search Complete")
If answer = vbYes Then wsSummary.Activate
End If
End Sub

 

[NoSparks]

In the first part, the resize of what to copy, are you sure the number of rows should be i and not just 1 ?

 

[ExcelGirl1988]

I'm not sure, I am still new to this but I have changed the i to 1 and the code does find all the complaints between the two dates that have been input but does not narrow the results by the keyword that has also been input

 

[NoSparks]

In your .find / .findnext you're not doing anything with the range that's found other than comparing its address with firstaddress.

Have you tried filtering rather than finding ?

 

[ExcelGirl1988]

No that's something I haven't tried, how would I go about doing this? Not sure where to start changing my code and how to change it right

 

[NoSparks]

Don't start changing code until you know if filtering will work.
Manually filter a column using Text Filter -- Contains to see if it will.

Remember, we don't know what you're actually working with or how many columns could possibly contain the keyword.
Your .find searching every single cell that gets copied suggests more than one column but you haven't said.

 

[ExcelGirl1988]

Sorry, only two columns could include the keyword being search for, columns C and D. I did the manual text filtering and this worked to bring up the rows with the keyword included so I would need to incorporate this into my code for it to filter the rows after the code has searched for and moved the correct rows by date.

 

[NoSparks]

Maybe this will work for you by writing into an unused column (ex: AA) from within the .find/.findnext loop

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Search for keyword
With Worksheets("Summary").Range("C:D")
    Set c = .Find(myString, LookIn:=xlValues, LookAt:=mySize, _
                  SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                  MatchCase:=False, SearchFormat:=False)
                  
    If Not c Is Nothing Then
        ' where first found
        firstaddress = c.Address
        Do
            ' in a helper column identify this as a row to keep
            wsSummary.Cells(c.Row, "AA").Value = "Keep"
            ' search for next occurrance
            Set c = .FindNext(c)
            ' keep searching as long as c is found and not at firstaddress
        Loop While Not c Is Nothing And c.Address <> firstaddress
    End If
End With

With wsSummary
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    ' hide rows without Keep
    .Range("AA2:AA" & lr).SpecialCells(xlBlanks).EntireRow.Hidden = True
End With
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

 

[ExcelGirl1988]

I got an error when using the code that highlighted the below part:

Set c = .Find(myString, LookIn:=xlValues, LookAt:=mySize, _
                  SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                  MatchCase:=False, SearchFormat:=False)

The error is: run-time error 9: subscript out of range

 

[NoSparks]

That's your original code.
I tried to change the range to just columns C and D
try changing it back to usedrange