Filter by Month & Year.

[adam]

Hi,

I’m trying to figure out a worksheet event code that would filter my datasheet by month and year when the user selects the month in cell J1 and year in M1.

Let’s say for example, if I write 2010 in cell M1 of my worksheet And June in cell J1. The code would filter all the data rows from June 2010.

My date formats are in dd/mm/yyyy.

I've attached the workbook to make my question clear.

Any help on this would be kindly appreciated.

Thanks in advance.

[HansV]

Try this:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim d1 As Date
  Dim d2 As Date
  ' Act only if J1 or M1 has changed
  If Not Intersect(Range("J1,M1"), Target) Is Nothing Then
    ' First day of the month
    d1 = DateSerial(Range("M1"), Application.Match(Range("J1"), Range("MonthList"), 0), 1)
    ' Last day of the month
    d2 = DateSerial(Range("M1"), Application.Match(Range("J1"), Range("MonthList"), 0) + 1, 0)
    ' Set up AutoFilter for dates between first and last
    Range("A1").CurrentRegion.AutoFilter Field:=1, _
      Criteria1:=">=" & CLng(d1), Operator:=xlAnd, Criteria2:="<=" & CLng(d2)
  End If
End Sub

Remarks:

Your sheet looks strange because the vertical alignment changes from column to column - some are top aligned, others bottom aligned.

If your workbook is meant for Arabic users, the arrow buttons are OK. But if it is intended for a Western audience, you should switch their actions: left = down and right = up.

[adam]

Thanks for the help Hans. I take your remarks.

The worksheet filters date if even the months and years doesn't exists in the worksheet. How could I create a message box which would give the message "no data for the specific month" or "no data for the specific year" when a user selects either a month or a year that that does not exist in the worksheet

[HansV]

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim d1 As Date
  Dim d2 As Date
  Dim m As Long
  Dim rng As Range
  Dim n As Long
  ' Act only if J1 or M1 has changed
  If Not Intersect(Range("J1,M1"), Target) Is Nothing Then
    ' First day of the month
    d1 = DateSerial(Range("M1"), Application.Match(Range("J1"), Range("MonthList"), 0), 1)
    ' Last day of the month
    d2 = DateSerial(Range("M1"), Application.Match(Range("J1"), Range("MonthList"), 0) + 1, 0)
    ' Last data row
    m = Range("A1").CurrentRegion.Rows.Count
    ' Date column
    Set rng = Range("A2:A" & m)
    ' Count number of filtered records
    n = Application.CountIfs(rng, ">=" & CLng(d1), rng, "<=" & CLng(d2))
    ' Test if no records
    If n = 0 Then
      ' Inform user
      MsgBox "There are no records for this month/year combination.", vbInformation
    Else
      ' Set up AutoFilter for dates between first and last
      Range("A1").CurrentRegion.AutoFilter Field:=1, _
        Criteria1:=">=" & CLng(d1), Operator:=xlAnd, Criteria2:="<=" & CLng(d2)
    End If
  End If
End Sub

[adam]

Thanks a lot Hans. Now the code does what I was expecting. I do really appreciate your help.

[adam]

How could I make the above code to hide the rows without applying the filter?

[HansV]

Change the lines

Code: Select all

      Range("A1").CurrentRegion.AutoFilter Field:=1, _
        Criteria1:=">=" & CLng(d1), Operator:=xlAnd, Criteria2:="<=" & CLng(d2)

to

Code: Select all

      Dim r As Long
      For r = 2 To m
        Range("A" & r).EntireRow.Hidden = (Range("A" & r) < CLng(d1) Or Range("A" & r) > CLng(d2))
      Next r

[adam]

Thanks for the help Hans.

[adam]

How could I make the code to hide the columns but not the rows with the values in cell “J1” & “M1”.
My column starts from column "B" and onwards.
My column headings are labeled with date values. The column headings are on Row 10 and columns get increased as more data gets added to the worksheet.

[HansV]

Surely you should be able to modify the code you have already been given to work with columns instead of rows.

[adam]

Should I change it as follows?

Code: Select all

Dim c As Long
      For c = 11 To m
        Range("B" & c).EntireColumn.Hidden = (Range("B" & c) < CLng(d1) Or Range("B" & c) > CLng(d2))
      Next c

[HansV]

No, Range("B" & c) is always in the same column, column B. Replace this with Cells(10, c). That is the cell in row 10 (with the headings) and in column number c.

If you want to start with column B, the second column, use

For c = 2 To m

[adam]

How should I change the following lines?

m = Range("A1").CurrentRegion.Rows.Count
' Date column
Set rng = Range("A2:A" & m)

Should the first line be "B10" instead of A1

[HansV]

Should the first line be "B10" instead of A1

Yes, and you should use Columns instead of Rows, because you want to count the number of columns.

Changte the line that csets the range to

Set rng = Range(Cells(10, 2), Cells(10, m))

Cells(10, 2) is cell B10 (row 10, column 2) and Cells(10, m) is the last filled cell in row 10.

[adam]

Here's how I have modified the code. If I select the month June and year 2009 the code does show the June of 2010.How may I prevent this?

Also as soon as I select the month I get the message "There are no records for this month/year combination" before I could select the Year

The code that I have written unhide and clear the value in cells J1 & M1 shows a debug message before clearing the values and unhiding the columns.

How could I make the code more effective.

I ve attached the current workbook for your reference

[HansV]

Try this:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim d1 As Date
  Dim d2 As Date
  Dim m As Long
  Dim rng As Range
  Dim n As Long
  Dim c As Long

  ' Act only if J1 or M1 has changed
  If Not Intersect(Range("J1,M1"), Target) Is Nothing Then
    Application.ScreenUpdating = False
    m = Range("B9").CurrentRegion.Columns.Count
    If Range("J1") = "" Or Range("M1") = "" Then
      For c = 2 To m + 1
        Cells(9, c).EntireColumn.Hidden = False
      Next c
    Else
      ' First day of the month
      d1 = DateSerial(Range("M1"), Application.Match(Range("J1"), Range("MonthList"), 0), 1)
      ' Last day of the month
      d2 = DateSerial(Range("M1"), Application.Match(Range("J1"), Range("MonthList"), 0) + 1, 0)
      ' Last data row
      ' Date column
      Set rng = Range(Cells(9, 2), Cells(9, m + 1))
      ' Count number of filtered records
      n = Application.CountIfs(rng, ">=" & CLng(d1), rng, "<=" & CLng(d2))
      ' Test if no records
      If n = 0 Then
        ' Inform user
        MsgBox "There are no records for this month/year combination.", vbInformation
      Else
        ' Hides rows for dates between first and last
        For c = 2 To m + 1
          Cells(9, c).EntireColumn.Hidden = Cells(9, c) < CLng(d1) Or Cells(9, c) > CLng(d2)
        Next c
      End If
    End If
    Application.ScreenUpdating = True
  End If
End Sub

[adam]

Thanks for the help Hans. It worked fine. But the code that Unhides the hidden column seems to be working slowly event with the lines Application.ScreenUpdating.

Is this because wrong arrangement of the lines?

[HansV]

Change ShowAllColumns as follows:

Code: Select all

Sub ShowAllColumns()
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Range("B9").CurrentRegion.EntireColumn.Hidden = False
  ActiveSheet.Range("J1,M1").ClearContents
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

No looping at all!

[adam]

Thanks a million for the help Hans. That was really nice of you.

[adam]

Instead of a worksheet event code; how could this code be changed into a standard module code?

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim d1 As Date
  Dim d2 As Date
  Dim m As Long
  Dim rng As Range
  Dim n As Long
  ' Act only if J1 or M1 has changed
  If Not Intersect(Range("J1,M1"), Target) Is Nothing Then
    ' First day of the month
    d1 = DateSerial(Range("M1"), Application.Match(Range("J1"), Range("MonthList"), 0), 1)
    ' Last day of the month
    d2 = DateSerial(Range("M1"), Application.Match(Range("J1"), Range("MonthList"), 0) + 1, 0)
    ' Last data row
    m = Range("A4").CurrentRegion.Rows.Count
    ' Date column
    Set rng = Range("A5:A" & m)
    ' Count number of filtered records
    n = Application.CountIfs(rng, ">=" & CLng(d1), rng, "<=" & CLng(d2))
    ' Test if no records
    If n = 0 Then
      ' Inform user
      MsgBox "There are no records for this month/year combination.", vbInformation
    Else
      ' Set up AutoFilter for dates between first and last
      Range("A4").CurrentRegion.AutoFilter Field:=1, _
        Criteria1:=">=" & CLng(d1), Operator:=xlAnd, Criteria2:="<=" & CLng(d2)
    End If
  End If
End Sub