I need urgent Excel Help

Achuks

New Member
Joined
Apr 27, 2015
Messages
26
Hello All,
I appreciate your great contribution to this forum, and in recognition of your wealth of knowledge I write to seek your assistance on an issues I am having. I have pivot table with data from cube, I need to filter the table based on the value of two date field Begin and end date. I have tried some of the script you used to assist in some issue but no success. I have sample of the data and Macro recorded filter script below. Thank you


Sub FilterMacro()
'
' FilterMacro Macro
' Date FilterMacro
'


'
ActiveSheet.PivotTables("PivotTable2").PivotFields( _
"[Date Dimension].[Fiscal Month].[Fiscal Month]").VisibleItemsList = Array( _
"[Date Dimension].[Fiscal Month].&[2013\14]&[5]", _
"[Date Dimension].[Fiscal Month].&[2013\14]&[6]", _
"[Date Dimension].[Fiscal Month].&[2013\14]&[7]", _
"[Date Dimension].[Fiscal Month].&[2013\14]&[8]", _
"[Date Dimension].[Fiscal Month].&[2013\14]&[9]", _
"[Date Dimension].[Fiscal Month].&[2013\14]&[10]", _
"[Date Dimension].[Fiscal Month].&[2013\14]&[11]", _
"[Date Dimension].[Fiscal Month].&[2013\14]&[12]", _
"[Date Dimension].[Fiscal Month].&[2014\15]&[1]", _
"[Date Dimension].[Fiscal Month].&[2014\15]&[2]", _
"[Date Dimension].[Fiscal Month].&[2014\15]&[3]", _
"[Date Dimension].[Fiscal Month].&[2014\15]&[4]", _
"[Date Dimension].[Fiscal Month].&[2014\15]&[5]", _
"[Date Dimension].[Fiscal Month].&[2014\15]&[6]", _
"[Date Dimension].[Fiscal Month].&[2014\15]&[7]", _
"[Date Dimension].[Fiscal Month].&[2014\15]&[8]", _
"[Date Dimension].[Fiscal Month].&[2014\15]&[9]", _
"[Date Dimension].[Fiscal Month].&[2014\15]&[10]")
End Sub

[TABLE="class: cms_table, width: 1225"]
<tbody>[TR]
[/TR]
[TR]
[TD]Date[/TD]
[TD="align: right"]1/01/2010[/TD]
[TD][/TD]
[TD]This Data is from MS SQL Cube , I want to filter using Begin date and End Date[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]End Date[/TD]
[TD="align: right"]30/06/2011[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Description[/TD]
[TD]Jan-2010[/TD]
[TD]Feb-2010[/TD]
[TD]Mar-2010[/TD]
[TD]Apr-2010[/TD]
[TD]May-2010[/TD]
[TD]Jun-2010[/TD]
[TD]Jul-2010[/TD]
[TD]Aug-2010[/TD]
[TD]Sep-2010[/TD]
[TD]Oct-2010[/TD]
[TD]Nov-2010[/TD]
[TD]Dec-2010[/TD]
[TD]Jan-2011[/TD]
[TD]Feb-2011[/TD]
[TD]Mar-2011[/TD]
[/TR]
[TR]
[TD]ABC[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ABC (Central)[/TD]
[TD][/TD]
[TD="align: right"]7[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ABC (North East)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ABC (South East)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ABC (South)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]7[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]5[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]7[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ABC (Sydney Metro)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ABC (West)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]DEF[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]DEF (Central)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]DEF (North East)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]7[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]DEF (South East)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]DEF (South)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]DEF (Sydney Metro)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]7[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]75[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Here is some (untested) code for you to try. Delete all the previous code and paste all this code into a Standard Code Module.

Code:
Public Sub FilterOLAP_PivotsByDateRange()
'--filters multiple pivottables with an OLAP source to show the
'    pivotitems for each fiscal month between two dates

'--the dates are entered by the user in this worksheet
'    and the pivottable is filtered when this macro is run

 Dim dtStart As Date, dtEnd As Date, dtCurr As Date
 Dim lFilterItemCount As Long, lNdx As Long
 Dim sErrMsg As String, sMemberKey As String
 Dim vFilterArray As Variant
 Dim pvf As PivotField
 Dim pvtArray() As PivotTable
 Dim wksPivot As Worksheet, wksInputs As Worksheet
  
 '--modify to match sheet name and cell addresses in input sheet
 Set wksInputs = ThisWorkbook.Sheets("12 Month Acq")
 Const sSTART_ADDR As String = "$F$3"
 Const sEND_ADDR As String = "$F$4"
 
 '--modify to match the OLAP pivotfield name to be filtered
 Const sFIELD_NAME As String = "[Date Dimension].[Fiscal Month].[Fiscal Month]"
 
 On Error GoTo ErrProc
 
 ReDim pvtArray(1 To 3)
 
 '--modify to match sheet name and pivottable names of the pivots to be filtered
 With ThisWorkbook
   Set pvtArray(1) = Sheets("12 Month Acq").PivotTables("PivotTable3")
   Set pvtArray(2) = Sheets("12 Month Payment Received").PivotTables("PivotTable3")
   Set pvtArray(3) = Sheets("12 Month Cancel").PivotTables("PivotTable4")
 End With
 
'--validate inputs
 dtStart = wksInputs.Range(sSTART_ADDR).Value2
 dtEnd = wksInputs.Range(sEND_ADDR).Value2
 If Not (dtStart > 0 And dtEnd > 0) Then GoTo ExitProc
 
 If dtEnd < dtStart Then
   MsgBox "End date cannot be before Start date"
   GoTo ExitProc
 End If
 
 '--adjust start and end dates to first of month
 dtStart = DateSerial(Year(dtStart), Month(dtStart), 1)
 dtEnd = DateSerial(Year(dtEnd), Month(dtEnd), 1)
 
  '-calculate number of fiscal months in date span
 lFilterItemCount = Year(dtEnd) * 12 + Month(dtEnd) - _
   (Year(dtStart) * 12 + Month(dtStart)) + 1
 
 ReDim vFilterArray(1 To lFilterItemCount)
 
 dtCurr = dtStart
 '--step through each month to build visibleitemslist array
 Do While dtCurr <= dtEnd
   sMemberKey = sGetMemberKey(dt:=dtCurr)
   lNdx = lNdx + 1
   vFilterArray(lNdx) = sMemberKey
   '--increment dtCurr to first of next month
   dtCurr = Application.EDate(dtCurr, 1)
 Loop
 
 '--apply filter
 Application.EnableEvents = False
 For lNdx = 1 To UBound(pvtArray)
   Set pvf = pvtArray(lNdx).PivotFields(sFIELD_NAME)
   pvf.VisibleItemsList = vFilterArray
 Next lNdx
 
 '--for debugging only
 Debug.Print vbCr & "Span: " & dtStart & " --> " & dtEnd
 For lNdx = LBound(vFilterArray) To UBound(vFilterArray)
   Debug.Print vFilterArray(lNdx)
 Next lNdx
 
ExitProc:
 On Error Resume Next
 Application.EnableEvents = True
 If Len(sErrMsg) Then MsgBox sErrMsg
 Exit Sub

ErrProc:
 sErrMsg = Err.Number & ": " & Err.Description
 Resume ExitProc
End Sub

Function sGetMemberKey(ByVal dt As Date) As String
'--returns a string representing the OLAP member key
'    corresponding to the input date

 Dim lFiscalMth As Long, lFiscalYear As Long
 Dim sReturn As String
 
 '--last month of fiscal year is June
 Const lFY_END As Long = 6
 Const sITEM_FORMAT As String = _
   "[Date Dimension].[Fiscal Month].&[YYYY\FY]&[FM]"
 
 lFiscalYear = IIf(Month(dt) <= lFY_END, Year(dt), Year(dt) + 1)
 lFiscalMth = (lFY_END + Month(dt) - 1) Mod 12 + 1
 
 '--substitute each value in format string
 sReturn = Replace(sITEM_FORMAT, "FY", Right(CStr(lFiscalYear), 2))
 sReturn = Replace(sReturn, "YYYY", CStr(lFiscalYear - 1))
 sReturn = Replace(sReturn, "FM", CStr(lFiscalMth))
 
 sGetMemberKey = sReturn
End Function
 
Upvote 0
Hello,
I just want to say Thank you, you are very good , Thank you.
I want to ask, what do it need to improve my learning of VBA? any special material to get?.
Thank you once again
 
Upvote 0
Hello Jerry,
I hope I am not boarding you too much, I am new to VBA my core has been Database administration but recently I found myself doing a bit of data analysis. I posted this thread on New thread posting but no response. Hence I decided to consult you again.
I need to get the first value (the actual value selected) from a list selected from a filter. I need to display this value in a cell say A5 on the sheet. The filter is coming from a SQL cube data as shown below. How can I get the "OPOP Suhurley" display in cell A5. Help out Brothers and Thank you

Code:
Sub Macrotest()
'
Macrotest Macro






   Range("B21").Select
   ActiveSheet.PivotTables("PivotTable2").PivotFields( _
       "[Development Activity].[Development Activity Description].[Development Activity Description]" _
       ).VisibleItemsList = Array( _
       "[Development Activity].[Development Activity Description].&[ OPOP Suhurley]", _
       "[Development Activity].[Development Activity Description].&[OPOP Suhurley (West)]" _
       , _
        "[Development Activity].[Development Activity Description].&[OPOP Suhurley (South)]" _
       , _
        "[Development Activity].[Development Activity Description].&[OPOP Suhurley Concert]" _
        , _
        "[Development Activity].[Development Activity Description].&[OPOP Suhurley Brochure]" _
        , _
        "[Development Activity].[Development Activity Description].&[OPOP Suhurley (Central)]" _
        , _
        "[Development Activity].[Development Activity Description].&[OPOP Suhurley (North East)]" _
        , _
        "[Development Activity].[Development Activity Description].&[OPOP Suhurley (South East)]" _
        , _
        "[Development Activity].[Development Activity Description].&[OPOP Suhurley (Sydney Metro)]" _
        )
        
        
 
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,243
Messages
6,170,967
Members
452,371
Latest member
Frana

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