• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Date Filter

ysherriff

Member
Hi,

From a dropdown user selects the following date format for months (09-2016, 10-2016, 11-2016, etc.) and for years they select (2016, 2017, etc.)

I have a macro that filters for the specified date but I believe there is a more efficient way of doing this. The way i am doing this now is creating a separate column and using the Text function to format the dates appropriately and my macro pulls from that column. Please see example of table below.

I believe there is a way in my vba code where i can format the filtered date field (column O) within VBA rather than creating additionals columns. Can anyone help? Below is the code that i am currently using.


upload_2016-10-9_10-42-34.png


upload_2016-10-9_10-44-38.png


Code:
        If Range("b7") = vbNullString Then 'it is blank
            dataWB.Close SaveChanges:=False
        Else
        If timeframe = "All Months" Then
             With ActiveSheet
               .Unprotect "ops"
               .AutoFilterMode = False
               .Columns("B:AB").EntireColumn.Hidden = False
               .ListObjects("CJR_TBL").Range.AutoFilter Field:=1, Criteria1:="<>"
             End With
             
          ElseIf timeframe = "2016" Then
             With ActiveSheet
               .Unprotect "ops"
               .AutoFilterMode = False
               .Columns("B:AB").EntireColumn.Hidden = False
               .ListObjects("CJR_TBL").Range.AutoFilter Field:=2, Criteria1:=timeframe
             End With
         
          ElseIf timeframe = "2017" Then
             With ActiveSheet
               .Unprotect "ops"
               .AutoFilterMode = False
               .Columns("B:AB").EntireColumn.Hidden = False
               .ListObjects("CJR_TBL").Range.AutoFilter Field:=2, Criteria1:=timeframe
             End With
             
            Else
              With ActiveSheet
               .Unprotect "ops"
               .AutoFilterMode = False
               .Columns("B:AB").EntireColumn.Hidden = False
               .ListObjects("CJR_TBL").Range.AutoFilter Field:=1, Criteria1:=timeframe
             End With

i have attached the full file if needed.
 
Why If .. elseif elseif ... endif
If You don't use timeframe later then You could test this:
Code:
If timeframe = "All Months" Then timeframe = "<>"
With ActiveSheet
    .Unprotect "ops"
    .AutoFilterMode = False
    .Columns("B:AB").EntireColumn.Hidden = False
    .ListObjects("CJR_TBL").Range.AutoFilter Field:=1, Criteria1:= timeframe
EndWith
 
Thanks for the response vletm but that is not the issue. There are two issues, if you look at the table, i have a column for month and year that is formatted based on column O. So if a the timeframe is Year, then column 2 is filtered. I want to know if there is a way to filter the timeframe only on the date field (column O) rather than having a helper columns which are column b and c
 
You can select 'timeframe case' too ... (check Field values)
if 'year' then Field:= 1
if 'month_year' then Field:= 2
if 'day/month/year' then Field:= 11
... and after that use 'almost' my previous code.
I know that You can do code from that idea, Okay?
 
Thanks vletm but i don't think that addresses my issue. I appreciate your help. i will see about another alternative.
 
Code:
With ActiveSheet
    .Unprotect "ops"
    TF = timeframe
    y = Val(Mid(TF, 4, 4))
    m = Val(Left(TF, 2))
    d = DateSerial(2099, 12, 31)    '   or max of O-column
    CV = 2
    Select Case Len(TF)
        Case 4
            CV = 0
            d = DateSerial(y, 12, 31)
        Case 6
            CV = 1
            d = DateSerial(y, m + 1, 1) - 1
    End Select
    d = Format(d, "m/d/yyyy")
    .Columns("B:AB").AutoFilter Field:=11
    If CV < 2 Then _
        .Columns("B:AB").AutoFilter Field:=11, Operator:=xlFilterValues, Criteria2:=Array(CV, d)
EndWith
 
Thank you but i am getting this error message:




upload_2016-10-9_14-16-48.png


upload_2016-10-9_14-16-58.png


Code:
If Range("b7") = vbNullString Then 'it is blank
            dataWB.Close SaveChanges:=False
            Else
                With ActiveSheet
                   .Unprotect "ops"
                   .AutoFilterMode = False
                   .Columns("B:AC").EntireColumn.Hidden = False
                   TF = timeframe
                   y = Val(Mid(TF, 4, 4))
                   m = Val(Left(TF, 2))
                   d = DateSerial(2099, 12, 31)    '   or max of O-column
                   cv = 2
                   Select Case Len(TF)
                       Case 4
                           cv = 0
                           d = DateSerial(y, 12, 31)
                       Case 6
                           cv = 1
                           d = DateSerial(y, m + 1, 1) - 1
                   End Select
                   d = Format(d, "m/d/yyyy")
                   .Columns("B:Ac").AutoFilter Field:=15
                   If cv < 2 Then _
                       .Columns("B:AC").AutoFilter Field:=15, Operator:=xlFilterValues, Criteria2:=Array(cv, d)
                End With
 
Everything works but the field will not filter. The filter doesn't recognize the date parameter and skips it.

For example i have 10-2016 filtered but it will not filter. I think it is best to do multiple if statements.

upload_2016-10-9_14-43-46.png

Code:
If Range("b7") = vbNullString Then 'it is blank
            dataWB.Close SaveChanges:=False
            Else
                With ActiveSheet
                   .Unprotect "ops"
                   .AutoFilterMode = False
                   .Columns("B:AC").EntireColumn.Hidden = False
                   TF = timeframe
                   y = Val(Mid(TF, 4, 4))
                   m = Val(Left(TF, 2))
                   d = DateSerial(2099, 12, 31)    '   or max of O-column
                   cv = 2
                   Select Case Len(TF)
                       Case 4
                           cv = 0
                           d = DateSerial(y, 12, 31)
                       Case 6
                           cv = 1
                           d = DateSerial(y, m + 1, 1) - 1
                   End Select
                   d = Format(d, "mm-dd-yyyy")
                   .ListObjects("CJR_TBL").Range.AutoFilter Field:=11
                   If cv < 2 Then _
                   .ListObjects("CJR_TBL").Range.AutoFilter Field:=11, Operator:=xlFilterValues, Criteria2:=Array(cv, d)
                End With


This is my code that works:

Code:
    If Range("b7") = vbNullString Then 'it is blank
            dataWB.Close SaveChanges:=False
            Else
          If timeframe = "All Months" Then
                 With ActiveSheet
                   .Unprotect "ops"
                   .AutoFilterMode = False
                   .Columns("B:AB").EntireColumn.Hidden = False
                   .ListObjects("CJR_TBL").Range.AutoFilter Field:=1, Criteria1:="<>"
                 End With
                
              ElseIf timeframe = "2016" Then
                 With ActiveSheet
                   .Unprotect "ops"
                   .AutoFilterMode = False
                   .Columns("B:AB").EntireColumn.Hidden = False
                   .ListObjects("CJR_TBL").Range.AutoFilter Field:=3, Criteria1:=timeframe
                 End With
            
              ElseIf timeframe = "2017" Then
                 With ActiveSheet
                   .Unprotect "ops"
                   .AutoFilterMode = False
                   .Columns("B:AB").EntireColumn.Hidden = False
                   .ListObjects("CJR_TBL").Range.AutoFilter Field:=3, Criteria1:=timeframe
                 End With
                
                Else
                  With ActiveSheet
                   .Unprotect "ops"
                   .AutoFilterMode = False
                   .Columns("B:AB").EntireColumn.Hidden = False
                   .ListObjects("CJR_TBL").Range.AutoFilter Field:=1, Criteria1:=timeframe
                 End With
            
              End If
              'copy filtered data
                Set tbl = ActiveSheet.AutoFilter.Range
                tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
                Selection.Copy
                
                 'activate generator workbook
                   currentWB.Activate
                  
                   'activate master worksheet
                   TargetSh.Activate
                                  
                   TargetSh.Range(DestCell.Address).Select
                   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                           :=False, Transpose:=False
                  Set DestCell = TargetSh.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                  dataWB.Close False
          End If
 
If You send ONLY like one sentence (= part of code) from book (=workbook) then it would be challenge to know the whole story (=test all or even something).
Of course You can use like: if ... elseif ... elseif ... elseif ... endif
There are just many many times almost same part of code ...
then it should be possible to write shorter (many times)!
and few years later ... You can add still 'few more elseif ... elseif ...' - YES!
 
I agree there is a shorter way to write the code but i will have to play with it next time. your code is okay but it will not filter correctly. i just don't have time to mess with it to understand the syntax becuase the project is due on monday. i will play with it when i have more time even though it is not an efficient way to write the code.


thanks for all your help vletm
 
Back
Top