Identificeren en format veranderen van Rijen en/of kolommen in een PIVOT

[Humadgen]

Bekijk bijlage PIVOT SUBS.zipHoi,

Twee vragen:
1. betreft een betere oplossing voor de Do-Loop die ik nu gebruik.
2. hoe ik in de rijen van een draaitabel de subtotal en Grand total rijen een kleur kan geven (zoals in het sheet BASIS)
Re: 1
Ik heb een bestand (sheet : BASIS) met een draaitabel (sheet: PIVOT) en in die draaitabel wil ik alle kolommen met het TOTAL verbergen. Op zich lukt me dat wel, met de code die in het voorbeeld bestand staat, maar ik weet zeker dat het niet de schoonheidsprijs krijgt.

Waar ik in de Do-Loop code nu

Loop Until IsEmpty(ActiveCell.Offset(3, 0))

gebruik

Zou ik eigenlijk liever iets willen hebben die zegt Loop Until (en dan de cel waarde “Grand Total”)

Dus vraag 1. Hoe kan ik in de VBA het Loop Until aanpassen met een Cell waarde.

Re: 2
Hoe kan ik middels VBA de Rijen met TOTALS vinden een een kleur geven (zoals in het voorbeeld in de sheet BASIS)

Voor wie met 1 of beide antwoorden komt alvast heel erg bedenkt voor het meedenken.

Grtnx
Humadgen

 

[Humadgen]

Hoi,

Niet helemaal normaal om mijn eigen vraag te beantwoorden, maar ik kwam zelf achter de oplossing voor het eerste deel van mijn probleem:
Ik wist niet hoe ik een waarde van een Cel in mijn Do-Untill Loop kno verwerken, maar voor wie het ook niet weet:

Voila: De betere oplossing van de Do-Untill LOOP is:

'Set Formules
    Range("C2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(R[2]C=""Grand Total"","""",IF(RIGHT(R[2]C,5)=""Total"",""Verberg"",""""))"
    
'LOOP Formules tot en met laatste kolom
    Range("C2").Select
    Selection.Copy
    Do
    ActiveCell.Offset(0, 1).Select
    ActiveSheet.Paste
    Loop Until ActiveCell.Offset(2, 0).FormulaR1C1 = "Grand Total"

Ik hoop dat iemand nog een idee heeft / mee kan denken over hou ik in de Rijen van de PIVOTS de kleuren kan toevoegen.

Ik ga zelf ook nog even puzzelen, maar alle hulp is welkom.
Alvast bedankt.

Grtnx
Humadgen

 

[Humadgen]

en al spelende vond ik ook het antwoord op het tweede deel

Voor wie het wil weten:

    ActiveSheet.PivotTables("PivotTable6").PivotSelect "sectie[All;Total]", _
        xlDataAndLabel, True
    With Selection.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
   
    ActiveSheet.PivotTables("PivotTable6").PivotSelect "'Column Grand Total'", _
        xlDataAndLabel, True
    With Selection.Interior
        .ColorIndex = 3        .Pattern = xlSolid
    End With

 

[Humadgen]

De gehele code is nu voor mij:

Sub Oplossingl()

'Reset alls kolommen en Rijen
    Cells.Select
    Selection.EntireRow.Hidden = False
    Selection.EntireColumn.Hidden = False

'Refresh Piv0t waardes
    ActiveSheet.PivotTables("PivotTable6").PivotCache.Refresh


'###############################
'#                             #
'#       VERBERG KOLOMMEN      #
'#                             #
'###############################

'Set Formules
    Range("C2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(R[2]C=""Grand Total"","""",IF(RIGHT(R[2]C,5)=""Total"",""Verberg"",""""))"
    
'LOOP Formules tot en met laatste kolom
    Range("C2").Select
    Selection.Copy
    Do
    ActiveCell.Offset(0, 1).Select
    ActiveSheet.Paste
    Loop Until ActiveCell.Offset(2, 0).FormulaR1C1 = "Grand Total"
    
'Paste - Special Values
    Rows("2:2").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

'LOOP - Hide - de kolommen met "Verberg"
    Range("a1").Select
    Do
'Vind "Verberg"
    Cells.Find(What:="Verberg", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
'Verberg de KOLOM
    Selection.EntireColumn.Hidden = True
    ActiveCell.Offset(0, 1).Select
    Loop Until IsEmpty(ActiveCell.Offset(3, 0))
    
    Range("a1").Select
   
   
    ActiveSheet.PivotTables("PivotTable6").PivotSelect "sectie[All;Total]", _
        xlDataAndLabel, True
    With Selection.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
   
    ActiveSheet.PivotTables("PivotTable6").PivotSelect "'Column Grand Total'", _
        xlDataAndLabel, True
    With Selection.Interior
        .ColorIndex = 3
        .Pattern = xlSolid
    End With
    Range("A1").Select
 
   
   
   
End Sub