Search by Date VBA code help

[ExcelGirl1988]

Hi, I hope someone can help with this, I am not sure what the issue is with my code. I have a complaints spreadsheet with a search by date option but this code is not working as it should. When I am searching for complaints between 01/04/2021 and 31/03/2022 it should find 20 complaints but instead it brings up 36, it is showing the complaints outside of the dates I am wanting. I hope someone can figure out where I made an error with my code, I have copied it below.

Option Explicit
Sub ExtractDataBasedOnDate_2()
    
    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
    
    Set wsSummary = ThisWorkbook.Worksheets("Summary")
    
    Application.ScreenUpdating = False
    
    With Worksheets("Home")
        StartDate = CDate(.Range("B1").Value)
        EndDate = CDate(.Range("B2").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

With ThisWorkbook.Worksheets("Summary").Sort
    .SortFields.Clear
     .SortFields.Add Key:=Range("B1"), Order:=xlAscending
     .SetRange Range("A:O")
     .Header = xlYes
     .Apply
End With

Set sht = ThisWorkbook.Worksheets("Home")
wsSummary.Range("A:O").RemoveDuplicates Columns:=Array(1, 4), 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
Else

End If
End If

End Sub

 

[ExcelGirl1988]

I don't know that I can analyze it any further without access to your file.
If you are able to upload a copy to a file sharing site and provide the link here, I can take a look at it later today when I have access to download files.
Be sure to "dummy up" any sensitive data, and provide an example with details that shows your expected values and your actual values.

Hi, thank you. The link to my file is below. The date search is still not working as it should, I have added comments on the spreadsheet regarding what is happening. Since taking out the confidential info in rows D-H the date search is finding less complaints rather than more than it should. Really weird.
Dummy Complaints Log

 

[Alex Blakenburg]

Your link is asking for a password. Can you make it available to anyone who has the link.
I am login off for the night soon but it sounds like @Joe4 will be trying your file later.

 

[ExcelGirl1988]

Hi, thank you. The link to my file is below. The date search is still not working as it should, I have added comments on the spreadsheet regarding what is happening. Since taking out the confidential info in rows D-H the date search is finding less complaints rather than more than it should. Really weird.
Dummy Complaints Log

Dummy Complaints Log I have edited the permissions so it should be able to be accessed without a password.

 

[Alex Blakenburg]

I don't think you get this screen if you set it up so others can see the file based on the link

 

[Joe4]

Alex,

Are you using a European version of Excel? I was hoping that someone who does would weigh in, as if the issue with the "American dates in VBA" is part of the problem for people using European versions of Excel, I cannot really rest that part of it.

 

[ExcelGirl1988]

I don't think you get this screen if you set it up so others can see the file based on the link

View attachment 89607

I signed out of my account and then clicked on the link and it took me to the workbook without asking for a password so it should work for you now.

 

[Fluff]

It's not the dates that is causing the problem.
This line

                    ws.Cells(i, 1).Resize(i, ws.Cells(i, ws.Columns.Count).End(xlToLeft).Column).Copy _

should be Resize(1, not i
And remove this line

wsSummary.Range("A:O").RemoveDuplicates Columns:=Array(1, 4), Header:=xlYes

 

[ExcelGirl1988]

It's not the dates that is causing the problem.
This line

                    ws.Cells(i, 1).Resize(i, ws.Cells(i, ws.Columns.Count).End(xlToLeft).Column).Copy _

should be Resize(1, not i
And remove this line

wsSummary.Range("A:O").RemoveDuplicates Columns:=Array(1, 4), Header:=xlYes

OMG I can’t believe it, that worked a treat, thank you! I have been going round in circles for days thinking that there was something wrong with the dates.

 

[Fluff]

Glad we could help & thanks for the feedback.