dss28
Board Regular
- Joined
- Sep 3, 2020
- Messages
- 165
- Office Version
- 2007
- Platform
- Windows
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:
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:
VBA Code:
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
