Date format in macro not recognized in autofilter

micko1

Board Regular
Joined
Feb 10, 2010
Messages
80
I am having probelms with excel not returning the correct date format to the autofilter. User inputs date, date is inserted into a cell and this is used in the autofilter to filter dates. Cells are formated to DD/MMM/YY. When the user inputs the date it is copied correctly to the cell reference but the autofilter does not recognise it correctly.
Any and all help would be greatly appreciated.
Code:
Sub test_filter_dates()
    Dim r As Range, filt As Range, d1 As Long, d2 As Long
    With Worksheets("Sheet1")
        Dim vResponse As Variant
        Dim vResponse1 As Variant
 Do
 vResponse = Application.InputBox( _
 Prompt:="Enter start date Format MM/DD/YY:", _
 Title:="Start Date", _
 Default:=Format(Date, "DD/MMM/YY"), _
 Type:=2)
 If vResponse = False Then Exit Sub 'User cancelled
 Loop Until IsDate(vResponse)
 Range("F1").Value = CDate(vResponse)
 Do
 vResponse1 = Application.InputBox( _
 Prompt:="Enter end date Format  DD/MMM/YY:", _
 Title:="End Date", _
 Default:=Format(Date, "DD/MMM/YY"), _
 Type:=2)
 If vResponse1 = False Then Exit Sub 'User cancelled
 Loop Until IsDate(vResponse1)
 Range("G1").Value = CDate(vResponse1)
 d1 = .Range("F1").Value
 d2 = .Range("G1").Value
 .Range("A1").CurrentRegion.AutoFilter Field:=.Range("A1").Column, Criteria1:=">=" & CDate(d1) _
 , Operator:=xlAnd, Criteria2:="<=" & CDate(d2)
 Set filt = .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
 'filt.Copy
  With Worksheets("Sheet2")
  .Cells.Clear
  filt.Copy
  .Range("a1").PasteSpecial
  .Range("A1:B1").EntireColumn.AutoFit
  End With
  .Range("A1").CurrentRegion.AutoFilter
  End With
  Worksheets("Sheet1").Activate
     
End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Try passing the dates to your long variable using DateSerial & see if that helps.

Code:
d1 = DateSerial(Year(.Range("F1").Value), Month(.Range("F1").Value), Day(.Range("F1").Value))

d2 = DateSerial(Year(.Range("G1").Value), Month(.Range("G1").Value), Day(.Range("G1").Value))
        
        .Range("A1").CurrentRegion.AutoFilter Field:=.Range("A1").Column, _
                                              Criteria1:=">=" & d1 _
                                            , Operator:=xlAnd, _
                                              Criteria2:="<=" & d2

Dave
 
Upvote 0
Dave
Thanks heaps. All is working great with your modifications. Thankyou very much for your help.

Mick
 
Upvote 0
Dave
Thanks heaps. All is working great with your modifications. Thankyou very much for your help.

Mick

Glad it worked & thanks for feedback.
Just as a suggestion which you may find helpful - rather than having two lots of code for your inputboxes, you can do it with just one in your Do Loop.
If you change your vResponse variable to a variant array you can collect your date input values like this:

Code:
Sub test_filter_dates()
    Dim r As Range, filt As Range, d1 As Long, d2 As Long
    Dim vResponse(2) As Variant
    Dim i As Integer
    Dim sPrompt() As Variant
    With Worksheets("Sheet1")
        sPrompt = Array("Start", "End")
        i = 0
        Do
            vResponse(i) = Application.InputBox( _
                           Prompt:="Enter " & sPrompt(i) & " date Format MM/DD/YY:", _
                           Title:=sPrompt(i) & " Date", _
                           Default:=Format(Date, "MM/DD/YY"), _
                           Type:=2)
            If vResponse(i) = False Then Exit Sub    'User cancelled
            If IsDate(vResponse(i)) Then i = i + 1
        Loop Until i > 1
        .Range("F1").Value = CDate(vResponse(0))
        .Range("G1").Value = CDate(vResponse(1))
        d1 = DateSerial(Year(.Range("F1").Value), Month(.Range("F1").Value), Day(.Range("F1").Value))
        d2 = DateSerial(Year(.Range("G1").Value), Month(.Range("G1").Value), Day(.Range("G1").Value))
        .Range("A1").CurrentRegion.AutoFilter Field:=.Range("A1").Column, _
                                              Criteria1:=">=" & d1 _
                                            , Operator:=xlAnd, _
                                              Criteria2:="<=" & d2
        Set filt = .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        'filt.Copy
        With Worksheets("Sheet2")
            .Cells.Clear
            filt.Copy
            .Range("a1").PasteSpecial
            .Range("A1:B1").EntireColumn.AutoFit
        End With
        .Range("A1").CurrentRegion.AutoFilter
    End With
    Worksheets("Sheet1").Activate
End Sub


Hope helpful

Dave
 
Upvote 0
Dave
Extremely helpful, thankyou once again.
Not sure if you can help but further to this I have another problem. The workbook I am palying with is obviously not mine. The guy has a sheet that has 2 columns for the month/ year. I have copied all data to a new sheet ( to allow me to filter at will on different columns and copy results elsewhere) and then placed a formula in the last column to join the data from the 2 columns (=b1&"-"&c1) eg Jan-12. Then tried to run the above macro to filter out the dates as required by the user. Problem is the macro does not recognise the formula results as a date. Tried this line in the code
Code:
Columns(10).NumberFormat = "mmm-yy"
Range("J2:J700").Formula = Range("J2:J700").Value
This then converts the formula to the correct value so the macro is able to filter the dates. Can this process be added to the macro so it joins the 2 columns and just returns the value to the cells. This is the code I am using to copy the data to the sheet.
Columns "A" through "I" copy from the "Sales" sheet to the "Data Input Date" sheet, Column "J" on the "Data Input Date" sheet contains the formula "=if(b2="","",B2&"-"&C2)". Hope this makes sense. Thanks for all assistance to date.

Code:
Sub Client_totals_Input_Date()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Sheets("Sales").Select
    Range("Data_input_Date").Select
    Selection.Copy
    Sheets("Data Input Date").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns(10).NumberFormat = "mmm-yy"
    Range("J2:J700").Formula = Range("J2:J700").Value
    
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 
Upvote 0
If code shown solves your problem just add before you filter something like this:

Code:
With Worksheets("Sheet1")
.Columns(10).NumberFormat = "mmm-yy"
.Range("J2:J700").Formula = .Range("J2:J700").Value

Note the period "." (full stops) in front of Range & Columns in the with Statement - when writing code try to ensure that ranges are qualified to the correct worksheet
While you can do this

Range("A1").Value ="Hello"

Its ok if you are always on the activesheet code is intended for - However, this is not always the case & not qualifying your range can give unwanted results.

Dave
 
Upvote 0
Dave
Extremely sorry about taking so long to get back to you. Thanks very much for all your help. Very much appreciated. This is what I came up with.
once the data is copied from the sales sheet I then run this code that places the formula in column "I" if there is data in that row.
Code:
Sub Test_Date_Input()
Dim WS As Worksheet
Dim bottomrow As Long
Set WS = Worksheets("Data Input Date")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
WS.Select
With WS
If .FilterMode Then .ShowAllData
If Range("$A$2") <= 0 Then
Exit Sub
Else: Range("$I$2") = "=IF($A2="""","""",$A2&""-""&$B2)"
bottomrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("I2").AutoFill Destination:=Range("I2:I" & bottomrow), Type:=xlFillDefault
End If
End With
With Sheets("Data Input Date")
.Columns(9).NumberFormat = "mmm-yy"
.Range("I2:I" & bottomrow).Formula = Range("I2:I" & bottomrow).Value
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Then use this to filter the dates based on the user input.

Code:
Sub test_filter_dates()
    Dim r As Range, filt As Range, d1 As Long, d2 As Long
    Dim vResponse(2) As Variant
    Dim i As Integer
    Dim sPrompt() As Variant
    With Worksheets("Data Input Date")
        sPrompt = Array("Start", "End")
        i = 0
        Do
            vResponse(i) = Application.InputBox( _
                           Prompt:="Enter " & sPrompt(i) & " date Format dd/mmm/yy:", _
                           Title:=sPrompt(i) & " Date", _
                           Default:=Format(Date, "DD/MMM/YY"), _
                           Type:=2)
                           
                           
            If vResponse(i) = False Then Exit Sub    'User cancelled
            If IsDate(vResponse(i)) Then i = i + 1
        Loop Until i > 1
        .Range("N1").Value = CDate(vResponse(0))
        .Range("O1").Value = CDate(vResponse(1))
        d1 = DateSerial(Year(.Range("N1").Value), Month(.Range("N1").Value), Day(.Range("N1").Value))
        d2 = DateSerial(Year(.Range("O1").Value), Month(.Range("O1").Value), Day(.Range("O1").Value))
        .Range("I1").CurrentRegion.AutoFilter Field:=.Range("I1").Column, _
                                              Criteria1:=">=" & d1 _
                                            , Operator:=xlAnd, _
                                              Criteria2:="<=" & d2
        Set filt = .Range("I1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        'filt.Copy
        With Worksheets("Data Input Date")
            '.Cells.Clear
            filt.Copy
            .Range("P1").PasteSpecial
            .Range("P1:X1").EntireColumn.AutoFit
        End With
        .Range("I1").CurrentRegion.AutoFilter
    End With
    Worksheets("Data Input Date").Activate
End Sub

This all appears to be giving me the results I was after. Thanks again for you help and input.
 
Upvote 0
No problem, glad what I did worked ok for you.
Thank you for your kind feedback

Dave
 
Upvote 0

Forum statistics

Threads
1,216,102
Messages
6,128,852
Members
449,471
Latest member
lachbee

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top