adamsm
07-08-2010, 03:33 AM
I have four pivot tables in my workbook which gets updated by data from two sheets.
The code that is embedded in the worksheet unhides the hidden rows as more data rows get added to the first pivot table and refreshes all the four pivot tables.
How could I embed the following code the existing worksheet code so that the pivot table gets filtered with data from specific month & Year?
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 within this combination.", vbInformation
Else
Range("A1").CurrentRegion.AutoFilter Field:=1, _
Criteria1:=">=" & CLng(d1), Operator:=xlAnd, Criteria2:="<=" & CLng(d2)
End If
End If
End Sub
I've attached the workbook for your reference.
Any help on this would be kindly appreciated.
The code that is embedded in the worksheet unhides the hidden rows as more data rows get added to the first pivot table and refreshes all the four pivot tables.
How could I embed the following code the existing worksheet code so that the pivot table gets filtered with data from specific month & Year?
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 within this combination.", vbInformation
Else
Range("A1").CurrentRegion.AutoFilter Field:=1, _
Criteria1:=">=" & CLng(d1), Operator:=xlAnd, Criteria2:="<=" & CLng(d2)
End If
End If
End Sub
I've attached the workbook for your reference.
Any help on this would be kindly appreciated.