ExcelGirl1988
New Member
- Joined
- Mar 27, 2017
- Messages
- 44
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.
VBA Code:
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
Let me know if you need any further data.
