• 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.

OLAP (cube) slicer

brumarx

New Member
Hello guys im new in this fórum, i ve tryed to search this topic here, but not results.

I was usig this code and it use slicer in a normal pivot table, but now im using this information from a Cube.

What this code do:
A loop in my slicer to copy this information to another sheet

This is the VBA Code:

Code:
Sub Análise_Parceiro()
'Count the time it started
Dim StartTime As Double
StartTime = Timer
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Name sheets and slicers
Dim Report_Sheet As Worksheet
Set Report_Sheet = ThisWorkbook.Sheets("AnáliseParceiro")
Dim Fonte_Sheet As Worksheet
Set Fonte_Sheet = ThisWorkbook.Sheets("Análise Global Ano")
Dim Indicadores_Sheet As Worksheet
Set Indicadores_Sheet = ThisWorkbook.Sheets("Indicadores")

Dim Slicer_Canal As SlicerCache
Dim Slicer_Cadeia As SlicerCache
Dim Slicer_Parceiro As SlicerCache
Dim Slicer_Setor As SlicerCache

Set Slicer_Canal = ActiveWorkbook.SlicerCaches("Slicer_Canal_de_Venda")
Set Slicer_Cadeia = ActiveWorkbook.SlicerCaches("Slicer_Cadeia1")
Set Slicer_Parceiro = ActiveWorkbook.SlicerCaches("Slicer_Parceiro1")
Set Slicer_Setor = ActiveWorkbook.SlicerCaches("Slicer_Setor_de_Negócio1")

Slicer_Canal.ClearManualFilter
Slicer_Cadeia.ClearManualFilter
Slicer_Parceiro.ClearManualFilter
Slicer_Setor.ClearManualFilter

Dim SI As SlicerItem

If Slicer_Parceiro.SlicerItems(1).Value = "" Then
    First_Selection = Slicer_Parceiro.SlicerItems(2).Value
Else
    First_Selection = Slicer_Parceiro.SlicerItems(1).Value
End If
   
 
For y = 1 To Slicer_Parceiro.SlicerItems.Count
    If Slicer_Parceiro.SlicerItems(y).Value <> First_Selection Then
        Slicer_Parceiro.SlicerItems(y).Selected = False
    End If
Next y
   

'Loop through slicers

y = 2
x = 1
    For Each SI In Slicer_Parceiro.SlicerItems
        Application.Calculation = xlCalculationManual
       
        If SI.HasData = False Then
            Exit For
        Else
       
            If SI.Value = "" Then
                x = x + 1
            Else
                SI.Selected = True
               
               
                If x <> 1 Then
                    Slicer_Parceiro.SlicerItems(x - 1).Selected = False
                End If
               
                Application.Calculation = xlCalculationAutomatic
               
                Report_Sheet.Activate
                Report_Sheet.Cells(y, 1) = SI.Value
                Report_Sheet.Cells(y, 2) = Indicadores_Sheet.Cells(2, 9)
                Report_Sheet.Cells(y, 3) = Fonte_Sheet.Cells(19, 3)
                Report_Sheet.Cells(y, 4) = Fonte_Sheet.Cells(20, 3)
                Report_Sheet.Cells(y, 5) = Fonte_Sheet.Cells(18, 3)
                Report_Sheet.Cells(y, 6) = Fonte_Sheet.Cells(21, 3)
                Report_Sheet.Cells(y, 7) = Fonte_Sheet.Cells(23, 3)
                Report_Sheet.Cells(y, 8) = Fonte_Sheet.Cells(24, 3)
                Report_Sheet.Cells(y, 9) = Fonte_Sheet.Cells(22, 3)
                Report_Sheet.Cells(y, 10) = Fonte_Sheet.Cells(28, 12)
                Report_Sheet.Cells(y, 11) = Fonte_Sheet.Cells(35, 3)
                Report_Sheet.Cells(y, 12) = Fonte_Sheet.Cells(29, 12)
                Report_Sheet.Cells(y, 13) = Fonte_Sheet.Cells(30, 12)
                Report_Sheet.Cells(y, 14) = Fonte_Sheet.Cells(37, 3)
                Report_Sheet.Cells(y, 15) = Fonte_Sheet.Cells(28, 3)
                Report_Sheet.Cells(y, 16) = Fonte_Sheet.Cells(30, 3)
                Report_Sheet.Cells(y, 17) = Fonte_Sheet.Cells(33, 12)
                Report_Sheet.Cells(y, 18) = Fonte_Sheet.Cells(39, 11)
                Report_Sheet.Cells(y, 19) = Fonte_Sheet.Cells(39, 12)
                Report_Sheet.Cells(y, 20) = Fonte_Sheet.Cells(42, 11)
                Report_Sheet.Cells(y, 21) = Fonte_Sheet.Cells(42, 12)
                Report_Sheet.Cells(y, 22) = Fonte_Sheet.Cells(52, 3)
               
                y = y + 1
                x = x + 1
               
            End If
        End If
    Next SI
   
   
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

'Count the time it took to run
Dim MinutesElapsed As String
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

'Notify User
MsgBox "This code ran sucessfully in " & MinutesElapsed & " minutes", vbInformation
End Sub
This is a code from normal Pivot Table

Now i get the error message:
Code:
Dim SI As SlicerItem

If Slicer_Parceiro.SlicerItems(1).Value = "" Then
    First_Selection = Slicer_Parceiro.SlicerItems(2).Value
Else
    First_Selection = Slicer_Parceiro.SlicerItems(1).Value
End If
Probally i will get some error in the next steps.

When i tryed to rec vba code, when i filter the slice i have:

Code:
    ActiveWorkbook.SlicerCaches("Slicer_parceiro1").VisibleSlicerItemsList = Array("[Query].[parceiro].&[A.C.M. POWER]")
    ActiveWorkbook.SlicerCaches("Slicer_parceiro1").ClearManualFilter
    ActiveWorkbook.SlicerCaches("Slicer_cadeia1").VisibleSlicerItemsList = Array("[Query].[cadeia].&[ACADEMIA]")
    ActiveWorkbook.SlicerCaches("Slicer_cadeia1").ClearManualFilter
    ActiveWorkbook.SlicerCaches("Slicer_Canal_de_Venda").VisibleSlicerItemsList = Array("[Query].[Canal_de_Venda].&[Motos]")
    ActiveWorkbook.SlicerCaches("Slicer_Canal_de_Venda").ClearManualFilter
    ActiveWorkbook.SlicerCaches("Slicer_Setor_de_Negócio1").VisibleSlicerItemsList = Array("[Query].[Setor de Negócio].&[Bicicletas e Desporto]")
    ActiveWorkbook.SlicerCaches("Slicer_Setor_de_Negócio1").ClearManualFilter
Well,

Thanks a lot guys
 

Chihiro

Excel Ninja
So, exactly what are you trying to do?

Extract only the current .VisibleSlicerItemsList? Or all SlicerItems in a given slicer?
 

brumarx

New Member
Im trying to run the old code with new pivot table. This new olap pivot

i cant use
If Slicer_Parceiro.SlicerItems(1).Value = "" Then

I need to use Array "" ? i dont know
 
Last edited:

Chihiro

Excel Ninja
So what is the purpose of your old code?

There are many ways to interact with OLAP Pivot, but exact code needed will significantly differ based on "HOW" you interact with it.
 

Chihiro

Excel Ninja
... You already have base from your macro recorder. Depending on what you are after, code will differ significantly. Can't really help you without details of what you are after as final result.

Ex: Reading "ONLY" the visible items, when there is manual selection (if all is selected, this method will not work).
Code:
Dim ar
Dim i As Long
ar = ActiveWorkbook.SlicerCaches("Slicer_parceiro1").VisibleSlicerItemsList
For i = LBound(ar) to UBound(ar)
    Debug.Print ar(i)
Next
 

brumarx

New Member
Yes i know its not work. When i try to use

Code:
If Slicer_Parceiro.SlicerItems(1).Value = "" Then
In this new pivot table this not work. can i only use Sliceritem in a normal pivot? i cant use it to get info from a pivot cube?

Your question from:
Code:
Dim ar
Dim i As Long
ar = ActiveWorkbook.SlicerCaches("Slicer_parceiro1").VisibleSlicerItemsList
For i = LBound(ar) to UBound(ar)
    Debug.Print ar(i)
Next

Code:
[Query].[parceiro].[All]
 
Last edited:

Chihiro

Excel Ninja
Why are you checking for each item? What is the purpose of it? Why are you checking fro blank? In OLAP based model, there really isn't need to loop through every SlicerItem to manipulate things.

I'm out, till you can either upload sample workbook demonstrating your need or details of what exactly you are trying to do with your code.
 

brumarx

New Member
Thanks @Chihiro, for the feedback.

In my work I can not transfer data, I can not even stick a pen drive, there are millions of security rules that do not allow data transfer.

What I need to do in my work at the moment is: run all possibilities for all the items in: [Query]. [parceiros]. [All]

It can be as slicer or pivot. Why? when an item is manually triggered, this info go through a series of calculations .

And with this information i create a Bd. (Iten for pivot + new itens)60211

Do you have a example how i can do it, where i don't need to use this code?
 

Attachments

Chihiro

Excel Ninja
So if using code, if only single slicer's single selection is to be read.
Code:
Dim ar
ar = ActiveWorkbook.SlicerCaches("Slicer_parceiro1").VisibleSlicerItemsList
Debug.Print ar(0)
If you can't adapt the code to suite your need... then you'd need to use CUBE functions to obtain selected slicer value(s).

Read the linked articles in below thread's post #2.
https://chandoo.org/forum/threads/applying-slicers-to-cubeset-cuberankedmember.41434/

As well as articles below:
https://blog.crossjoin.co.uk/2016/09/14/using-the-cubeset-function-to-combine-selections-from-multiple-slicers-in-excel-power-pivot-reports/
https://powerpivotpro.com/2012/11/better-way-to-catch-multiple-slicer-selections-in-a-formula/
 

brumarx

New Member
Well im trying this:

Code:
Dim sC As SlicerCache
Dim sL As SlicerCacheLevel
Dim sI As SlicerItem
Dim Report_Sheet As Worksheet
Set Report_Sheet = ThisWorkbook.Sheets("AnáliseParceiro")
Dim Indicadores_Sheet As Worksheet
Set Indicadores_Sheet = ThisWorkbook.Sheets("Indicadores")

Set sC = ThisWorkbook.SlicerCaches("Slicer_Parceiro1")
Set sL = sC.SlicerCacheLevels(1)

For Each sI In sL.SlicerItems

    Next sI
This take all itens for me, now i need to copy information to another sheet. Can u help me with this part?

Code:
y = 2
x = 1
    For Each sI In sL.SlicerItems
        Application.Calculation = xlCalculationManual
        
        If sI.HasData = False Then
            Exit For
        Else
        
            If sI.Value = "" Then
                x = x + 1
            Else
                sI.Selected = True
                
                
                If x <> 1 Then
                    Slicer_Parceiro.SlicerItems(x - 1).Selected = False
                End If
                
                Application.Calculation = xlCalculationAutomatic
                
                Report_Sheet.Activate
                Report_Sheet.Cells(y, 1) = sI.Value
                Report_Sheet.Cells(y, 2) = Indicadores_Sheet.Cells(2, 9)
                
                y = y + 1
                x = x + 1
                
            End If
        End If
    Next sI
 

brumarx

New Member
Well @Chihiro, Thanks for all, i fixed de code and i will show for you and another members. Thanks a lot.

Code:
Sub test()

Dim Report_Sheet As Worksheet
Set Report_Sheet = ThisWorkbook.Sheets("AnáliseParceiro")
Dim Fonte_Sheet As Worksheet
Set Fonte_Sheet = ThisWorkbook.Sheets("Análise Global Ano")
Dim Indicadores_Sheet As Worksheet
Set Indicadores_Sheet = ThisWorkbook.Sheets("Indicadores")

Dim sC As SlicerCache
Dim sL As SlicerCacheLevel
Dim sI As SlicerItem
Set sC = ThisWorkbook.SlicerCaches("Slicer_cadeia1")
Set sL = sC.SlicerCacheLevels(1)

sC.ClearManualFilter
y = 2
x = 1
For Each sI In sL.SlicerItems
'Debug.Print sI.Caption
'Debug.Print CStr(sI.Value)
'Debug.Print sI.Name
ActiveWorkbook.SlicerCaches("Slicer_cadeia1").VisibleSlicerItemsList = Array(sI.Name)

'Loop through slicers

        Application.Calculation = xlCalculationManual

        If sI.HasData = False Then
            Exit For
        Else

            If sI.Value = "" Then
                x = x + 1
           Else
            First_Selection = sI.Value

                Application.Calculation = xlCalculationAutomatic

                Report_Sheet.Activate
                Report_Sheet.Cells(y, 1) = sI.Value
                Report_Sheet.Cells(y, 2) = Indicadores_Sheet.Cells(2, 9)
                Report_Sheet.Cells(y, 3) = Fonte_Sheet.Cells(19, 3)
                Report_Sheet.Cells(y, 4) = Fonte_Sheet.Cells(20, 3)
                Report_Sheet.Cells(y, 5) = Fonte_Sheet.Cells(18, 3)
                Report_Sheet.Cells(y, 6) = Fonte_Sheet.Cells(21, 3)
                Report_Sheet.Cells(y, 7) = Fonte_Sheet.Cells(23, 3)
                Report_Sheet.Cells(y, 8) = Fonte_Sheet.Cells(24, 3)
                Report_Sheet.Cells(y, 9) = Fonte_Sheet.Cells(22, 3)
                
                y = y + 1
                x = x + 1


            End If
        End If
Next sI

End Sub
 
Top