Sub Between2Dates()
'declare the variables
Dim rng as Range
Dim rng_copy as Range
Dim fromDate as Long
Dim toDate as Long
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
'set the variables
Set rng = Sheet2.Range("A1:B200")
Set rng_copy = Sheet6.Range("AA1")
'clear previous results
rng_copy.Clear
'attribute date values to variables
Set fromDate = Sheet6.Range("F1").Value
Set toDate = Sheet6.Range("F2").Value
'convert to text format to allow filtering
fromDate = Format(fromDate, "dd-mmm-yyyy")
toDate = Format(toDate, "dd-mmm-yyyy")
On Error GoTo ErrHandler
'check the dates if all is OK run the filter
If fromDate >= toDate Then
MsgBox " Your start value is wrong"
Resume Next
If Not IsEmpty(toDate) And Not IsEmpty(fromDate) Then
'Set the filtered range
With rng
If Not rng Is Nothing Then
'removes autofilter
If .FilterMode Then .ShowAllData
Else
.AutoFilterMode = False
'filter the data based on selected date values
.rng.AutoFilter Field:=6, Criteria1:= ">=" & fromDate, Operator:=xlAnd, Criteria2:="<=" & toDate
'copy the filtered data
.UsedRange.SpecialCells(xlCellTypeVisible).Copy
'paste copied values to results sheet
rng_copy.PasteSpecial
'Auto adjusting the size of selected columns
Selection.Columns.AutoFit
End If
End If
End With
End If
Exit sub
ErrHandler:
MsgBox "No records are available to copy..."
'select cell in results sheet
Sheet6.Activate
Sheet6.Range("AA1").Select
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub
'declare the variables
Dim rng as Range
Dim rng_copy as Range
Dim fromDate as Long
Dim toDate as Long
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
'set the variables
Set rng = Sheet2.Range("A1:B200")
Set rng_copy = Sheet6.Range("AA1")
'clear previous results
rng_copy.Clear
'attribute date values to variables
Set fromDate = Sheet6.Range("F1").Value
Set toDate = Sheet6.Range("F2").Value
'convert to text format to allow filtering
fromDate = Format(fromDate, "dd-mmm-yyyy")
toDate = Format(toDate, "dd-mmm-yyyy")
On Error GoTo ErrHandler
'check the dates if all is OK run the filter
If fromDate >= toDate Then
MsgBox " Your start value is wrong"
Resume Next
If Not IsEmpty(toDate) And Not IsEmpty(fromDate) Then
'Set the filtered range
With rng
If Not rng Is Nothing Then
'removes autofilter
If .FilterMode Then .ShowAllData
Else
.AutoFilterMode = False
'filter the data based on selected date values
.rng.AutoFilter Field:=6, Criteria1:= ">=" & fromDate, Operator:=xlAnd, Criteria2:="<=" & toDate
'copy the filtered data
.UsedRange.SpecialCells(xlCellTypeVisible).Copy
'paste copied values to results sheet
rng_copy.PasteSpecial
'Auto adjusting the size of selected columns
Selection.Columns.AutoFit
End If
End If
End With
End If
Exit sub
ErrHandler:
MsgBox "No records are available to copy..."
'select cell in results sheet
Sheet6.Activate
Sheet6.Range("AA1").Select
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub