Monday, March 24, 2008

Code to View Pivot Data within a date range

The following code works on the pivot with the following format :






Items Date1Date2Date3Date4
Item 1 DataDataDataData
Item 2 DataDataDataData
Item 3 DataDataDataData
Item 4DataDataDataData


Suppose, if you have a combobox with the date range, and you want to show those date columns which fall in the given range, following is the code which you can use. The example takes a week input from the user, where, in the AN Column, the Combobox option is given and in the AO column, the actual date value is given. For example, in AN1 the value is given as February-17 to February-23, and in AO1, the value of Feb 17 is given as 39495.


Public Sub CMBMacro()
Dim prevIndx As Integer
Dim cmbValue As Long
Dim upRange As Long
Dim pivot As PivotTable
Dim pvtItm As PivotItem
Dim ifNum As Long
Dim iCounter As Integer
Dim strngArr() As String
Dim strngCn As String
Dim prvDate As Long
Dim position As Integer
Dim prevItm() As PivotItem
Dim indxChckd As Integer
Dim extDate As Integer
Dim bool As Boolean
indxChckd = Me.Range("k1").Value
cmbValue = Me.Range("AO" & indxChckd).Value - 1 ' It will take the Date selected in the combo.
upRange = cmbValue + 7 'It will add up 7 days to get the upper range of the week.
iCounter = 0
If Not Application.EnableEvents Then
Exit Sub
End If
position = 2
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set pivot = Me.PivotTables(pvtName)
bool = False
For Each pvtItm In pivot.PivotFields("Date").PivotItems
If IsDate(pvtItm.Value) And pvtItm.RecordCount > 0 Then
ifNum = CDate(pvtItm.Value)
If ifNum > cmbValue And ifNum < upRange Then
If pvtItm.Visible = False Then pvtItm.Visible = True
bool = True
iCounter = iCounter + 1
End If
End If
Next
ReDim prevItm(iCounter)
iCounter = 1

For Each pvtItm In pivot.PivotFields("Date").PivotItems
If IsDate(pvtItm.Value) And pvtItm.RecordCount > 0 Then
ifNum = CDate(pvtItm.Value)
If (ifNum <= cmbValue Or ifNum >= upRange) And pvtItm.Visible = True And bool Then
pvtItm.Visible = False
End If

If pvtItm.Visible = True Then
Set prevItm(iCounter) = pvtItm
iCounter = iCounter + 1
End If
End If
Next


************************************************The Following Code sorts the date columns. It is required if the date columns are not sorted by default********* *************************************
For position = 1 To UBound(prevItm)
prvDate = CDate(prevItm(position))
For iCounter = position + 1 To UBound(prevItm)
ifNum = CDate(prevItm(iCounter))
If prvDate > ifNum Then
prevItm(position).position = prevItm(iCounter).position
End If
Next
Next

If Not bool Then
MsgBox "No Items Found for this range.", vbCritical, "Error"
End If

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub



Hope this has helped you all.

Thanks,
Vikas

3 comments:

Kellee said...

Good post.

Anonymous said...

Opulently I agree but I dream the post should acquire more info then it has.

Anonymous said...

Amiable post and this mail helped me alot in my college assignement. Gratefulness you seeking your information.