filter same column to get data between two dates

[dss28]

I am trying to build a code to filter column D (date Column) to extract data between two dates which i specify in a userform in two textboxes (start and end date).

when I run the code i only get the headers in the newly created shet but rest of the data is not filtered/copied/pasted (?).

I tried date formats such as dd/mm/yyyy, mm/dd/yyyy, mmm/dd/yyyy, number format but I am getting only the header part.

request for help to sort the issue.

my code is as follows:

Sub FilterBetweenDates()

'' get data between two dates from TotalReport and save in new work book


Application.ScreenUpdating = False

Dim X As Range

Dim rng As Range

Dim last As Long

Dim sht As String

Dim newBook As Excel.Workbook

Dim Workbk As Excel.Workbook



'Specify sheet name in which the data is stored

sht = "TotalReport"



'Workbook where VBA code resides

Set Workbk = ThisWorkbook



'New Workbook

Set newBook = Workbooks.Add(xlWBATWorksheet)

Workbk.Activate



'specify filter range in the following code

last = Workbk.Sheets(sht).Cells(Rows.Count, "B1:H").End(xlUp).row



With Workbk.Sheets(sht)

Set rng = .Range("B1:H" & last)

End With


' filtering code =========== date in column D ========================================

With Sheet19

With rng

.AutoFilter

.AutoFilter Field:=4, Criteria1:=">=" & UserForm36.TextBox1.Value, Operator:=xlAnd 'start date"

.AutoFilter Field:=4, Criteria2:="<=”&UserForm36.TextBox2.Value, Operator:=xlAnd 'end date"


'=============== copy=============================

With rng1

.SpecialCells(xlCellTypeVisible).Copy

'=====add new workbook and paste the filtered data============

Application.Workbooks.Add 1

newBook.Activate

Range("B3").Select

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

End With


Workbk.Sheets(sht).AutoFilterMode = False


With Application

.CutCopyMode = False

.ScreenUpdating = True


End With


End With


MsgBox " A new workbook has been created, name the file and save", vbOKOnly, "Report between Two Dates "


End With


End Sub

 

[NoSparks]

Try this

Sub FilterBetweenDates()
'' get data between two dates from TotalReport and save in new work book
Application.ScreenUpdating = False

Dim X As Range
Dim rng As Range
Dim last As Long
Dim sht As Worksheet
Dim newBook As Workbook
Dim Workbk As Workbook

'Workbook where VBA code resides
Set Workbk = ThisWorkbook
'Specify sheet with the data
Set sht = Workbk.Sheets("TotalReport")

'specify filter range
With sht
    last = .Range("B:H").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    Set rng = .Range("B1:H" & last)
End With

' filter and copy
With rng
    .AutoFilter
    .AutoFilter Field:=3, Criteria1:=">=" & CDate(UserForm36.TextBox1.Value), Operator:=xlAnd, _
                          Criteria2:="<=" & CDate(UserForm36.TextBox2.Value)
    .SpecialCells(xlCellTypeVisible).Copy
End With

'Add New Workbook
Set newBook = Workbooks.Add
Range("B3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Workbk.Activate
sht.AutoFilterMode = False

With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With

MsgBox " A new workbook has been created, name the file and save", vbOKOnly, "Report between Two Dates "

End Sub

 

[dss28]

Try this

Sub FilterBetweenDates()
'' get data between two dates from TotalReport and save in new work book
Application.ScreenUpdating = False

Dim X As Range
Dim rng As Range
Dim last As Long
Dim sht As Worksheet
Dim newBook As Workbook
Dim Workbk As Workbook

'Workbook where VBA code resides
Set Workbk = ThisWorkbook
'Specify sheet with the data
Set sht = Workbk.Sheets("TotalReport")

'specify filter range
With sht
    last = .Range("B:H").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    Set rng = .Range("B1:H" & last)
End With

' filter and copy
With rng
    .AutoFilter
    .AutoFilter Field:=3, Criteria1:=">=" & CDate(UserForm36.TextBox1.Value), Operator:=xlAnd, _
                          Criteria2:="<=" & CDate(UserForm36.TextBox2.Value)
    .SpecialCells(xlCellTypeVisible).Copy
End With

'Add New Workbook
Set newBook = Workbooks.Add
Range("B3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Workbk.Activate
sht.AutoFilterMode = False

With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With

MsgBox " A new workbook has been created, name the file and save", vbOKOnly, "Report between Two Dates "

End Sub

no luck either with this sir...
only the header is copied on the new workbook created.

do the textboxes 1 and 2 on the userform need any coding to transfer the figures as dates?

 

[Alex Blakenburg]

Try replacing the "filter and copy" with..end with section in @NoSparks, code with this.

    ' filter and copy
    With rng
        .AutoFilter
        .AutoFilter Field:=3, Criteria1:=">=" & CLng(CDate(UserForm36.TextBox1.Value)), Operator:=xlAnd, _
                              Criteria2:="<=" & CLng(CDate(UserForm36.TextBox2.Value))
        .Copy
    End With

 

[dss28]

Try replacing the "filter and copy" with..end with section in @NoSparks, code with this.

    ' filter and copy
    With rng
        .AutoFilter
        .AutoFilter Field:=3, Criteria1:=">=" & CLng(CDate(UserForm36.TextBox1.Value)), Operator:=xlAnd, _
                              Criteria2:="<=" & CLng(CDate(UserForm36.TextBox2.Value))
        .Copy
    End With

If I transfer the userform textbox start and end date values in the sheet ... say to M1 and N1 cell and apply the autofilter code as below with reference to these cells, it is working.
Also while doing this I changed the format of the dates to mm/dd/yyyy

Dim lngStart As Long, lngEnd As Long

lngStart = Range("M1").Value 'assume this is the start date

lngEnd = Range("N1").Value 'assume this is the end date

Range("A1:J9999").AutoFilter field:=4, Criteria1:=">=" & lngStart, Operator:=xlAnd, Criteria2:="<=" & lngEnd, Operator:=xlAnd

Range("A1:J9999").SpecialCells(xlCellTypeVisible).Copy

Now need to change the range ("A1:J9999") to "End(xlUp).row" type.

will update and seek guidance on this further in case I am stuck somewhere.. Do stay back with me... Thanks.

 

[NoSparks]

Now need to change the range ("A1:J9999") to "End(xlUp).row" type.

If there is no data beyond row 9999 you only need the columns as per finding last in post 11

 

[dss28]

If there is no data beyond row 9999 you only need the columns as per finding last in post 11

done up
essentials required to fetch the data,
1) date format in mm/dd/yyyy in the date column and userform textbox entry
and then reformated the date column back to dd/mm/yyyy
thanks everybody