Excel VBA Find Data Between Two Dates
Records in between two specific dates easily can be filtered using drop-down lists .
Ago ,drop-down lists (combo boxes) were filled with unique values as ascending order using ADO connection. Thus, it is easier to choose between the dates on the worksheet. The used codes for this :
Set con = CreateObject("adodb.connection")
Sheets("Page1").ComboBox1.Clear
Sheets("Page1").ComboBox2.Clear
#If VBA7 And Win64 Then
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=yes"""
#Else
con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=yes"""
#End If
Set rs = CreateObject("adodb.recordset")
sorgu = "select Date from [Page1$] group by Date"
rs.Open sorgu, con, 1, 1
While Not rs.EOF
Sheets("Page1").ComboBox1.AddItem VBA.Format(rs("Date").Value, "dd.mm.yyyy")
Sheets("Page1").ComboBox2.AddItem VBA.Format(rs("Date").Value, "dd.mm.yyyy")
rs.movenext
Wend
Sheets("Page1").ComboBox1.Clear
Sheets("Page1").ComboBox2.Clear
#If VBA7 And Win64 Then
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=yes"""
#Else
con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=yes"""
#End If
Set rs = CreateObject("adodb.recordset")
sorgu = "select Date from [Page1$] group by Date"
rs.Open sorgu, con, 1, 1
While Not rs.EOF
Sheets("Page1").ComboBox1.AddItem VBA.Format(rs("Date").Value, "dd.mm.yyyy")
Sheets("Page1").ComboBox2.AddItem VBA.Format(rs("Date").Value, "dd.mm.yyyy")
rs.movenext
Wend
Then ,the data between the two dates selected from combo boxes is filtered through Vba codes :
lngStart = VBA.CDate(Sheets("Page1").ComboBox1) 'assume this is the start date
lngEnd = VBA.CDate(Sheets("Page1").ComboBox2) 'assume this is the end date
If lngStart > lngEnd Then
MsgBox "The Start Date Can Not Be Bigger Than The End Date.", vbCritical, ""
Exit Sub
End If
Sheets("Page1").Range("B1").AutoFilter field:=1, _
Criteria1:=">=" & lngStart, Operator:=xlAnd, Criteria2:="<=" & lngEnd
lngEnd = VBA.CDate(Sheets("Page1").ComboBox2) 'assume this is the end date
If lngStart > lngEnd Then
MsgBox "The Start Date Can Not Be Bigger Than The End Date.", vbCritical, ""
Exit Sub
End If
Sheets("Page1").Range("B1").AutoFilter field:=1, _
Criteria1:=">=" & lngStart, Operator:=xlAnd, Criteria2:="<=" & lngEnd
The filtered data can be copied to other sheet if it wished.
No comments:
Post a Comment