Show outline around entire row when selecting a cell in a Pivot Table

[Vivek D]

I have a pretty wide pivot table showing a number of metrics for a number of clients. Because the Client name is to the far left, when looking at a metric to the far right, it kind of gets difficult to figure out which client a metric belongs to. I could add a border but that makes the table look a little busy especially as each column is color coded.

What I'd ideally like to do is something like below but the outline should not have the grayish tint. It should be clear like the first column i.e. EEE. Is there a way to get that effect on click of a cell within the pivot table?

 

[Luke M]

Hi Vivek,

Right-click on the sheet tab, view code, paste this in.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim pt As PivotTable
Dim rngPT As Range

'Which PivotTable?
Set pt = ActiveSheet.PivotTables(1)
'Define the range object
Set rngPT = pt.TableRange1

'Test if we need to do anything
If Intersect(Target, rngPT) Is Nothing Then Exit Sub

Application.ScreenUpdating = False

'Clear any previous formatting
rngPT.Borders.LineStyle = xlNone

'Apply this green border
With Intersect(Target.EntireRow, rngPT)
    With .Borders
        .LineStyle = xlContinuous
        .ThemeColor = 7
        .TintAndShade = 0
        .Weight = xlThick
    End With
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Application.ScreenUpdating = True
End Sub

Currently set to draw a green rectangle around the row of cell you select

 

[Chihiro]

@Luke M Neat and tidy code. I had similar code but did not have check for Pivot range and had hard coded starting Column.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lCol As Long
Dim hRow As Long
Dim hRange As Range

Cells.Borders.LineStyle = xlLineStyleNone

With ActiveSheet
hRow = Selection.Row
lCol = .Cells(hRow, .Columns.Count).End(xlToLeft).Column
Set hRange = .Range(.Cells(hRow, 1), .Cells(hRow, lCol))
hRange.BorderAround ColorIndex:=3, Weight:=xlThick

End With

End Sub

 

[Vivek D]

This is excellent guys...

Slight addition requirement. When I click on a cell it should show the border. Clicking again, should remove the border. Tried for a little time but can't figure out what field I should check to determine if border exists.

 

[Luke M]

Hmm. XL doesn't actually detect anything if you single click a cell that is already selected, so we have to try something else. Can we make it so that a double-click removes the formatting? If that's acceptable, add this to what you already have

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Target.EntireRow.Borders.LineStyle = xlNone
Cancel = True
End Sub

 

[Vivek D]

Yup, that's acceptable but I am now thinking that moving the whole thing to double click will be better. That way user can double click if they are having trouble identifying the line instead of highlighting it every time.

So if a user double-clicks on a cell, it will add border. If user double-clicks again on a cell in the same row or same cell, it will remove border.
If a border is present on a row and user double clicks a different cell then it will remove border of existing row and show border for the new cell-row.

 

[Luke M]

Sounds good. Clear out everything you already have, replace it with this.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim pt As PivotTable
Dim rngPT As Range

'Which PivotTable?
Set pt = ActiveSheet.PivotTables(1)
'Define the range object
Set rngPT = pt.TableRange1

'Test if we need to do anything
If Intersect(Target, rngPT) Is Nothing Then Exit Sub

Application.ScreenUpdating = False
Cancel = True

'Test if border already exists on current row
If Target.Borders(xlEdgeBottom).LineStyle <> xlNone And Target.Borders(xlEdgeTop).LineStyle <> xlNone Then
    'Only need to clear border, do nothing else
    rngPT.Borders.LineStyle = xlNone
Else
    'Clear borders and apply new ones
    rngPT.Borders.LineStyle = xlNone
   
    'Apply this green border
    With Intersect(Target.EntireRow, rngPT)
        With .Borders
            .LineStyle = xlContinuous
            .ThemeColor = 7
            .TintAndShade = 0
            .Weight = xlThick
        End With
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
End If

Application.ScreenUpdating = True

End Sub

 

[Vivek D]

Works perfectly. Thanks a lot.

On a side note.. how can one see list of available values for a given property
e.g. If I wanted to see the available values for .Weight, is there any way to get that apart from referring to documentation.
Ctrl + Spacebar pulls up lot of things that are not relevant too.

 

[Luke M]

Glad to hear it's working nicely.

If the dropdown suggestion doesn't show up, or isn't helping, fastest for me is using the Offline help. Then I can just select the property (Weight), hit F1, and it'll take me to that page. With your example, the help on Weight shows this:


Clicking the blue xlBorderWeight gives us:


Which is what we want.

Other things, like the different borders, will give a nice dropdown as I type to help out.


Does that help?

 

[Vivek D]

Thanks Yes. That's definitely helpful. I really should take a VBA course. I try to avoid using VBA as much as possible but have ended up using it a fair deal to enhance user experience of dashboards.

Right now, I just think about what I want, try to record macro, if not search and find or ask in forums so it's kind of bits and pieces type code.

 

[Vivek D]

One minor complication... I have some vertical borders applied within the pivot table and the above code clears those as well which I don't want it to.

I modified the code as shown below and it works. Just wanted to check if what I have written is optimal code or not i.e. Do I need to repeat the bordercolor, tint and weight settings for each border or is there a shorter way to write it?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim pt As PivotTable
    Dim rngPT As Range

    'Which PivotTable?
    Set pt = ActiveSheet.PivotTables("Org_Performance")
    'Define the range object
    Set rngPT = pt.TableRange1

    'Test if we need to do anything
    If Intersect(Target, rngPT) Is Nothing Then Exit Sub

    Application.ScreenUpdating = False
    Cancel = True

    'Test if border already exists on current row
    If Target.Borders(xlEdgeBottom).LineStyle <> xlNone And Target.Borders(xlEdgeTop).LineStyle <> xlNone Then
       
        'Only need to clear border, do nothing else
        rngPT.Borders(xlInsideHorizontal).LineStyle = xlNone
               
    Else
        'Clear any previous borders
        rngPT.Borders(xlInsideHorizontal).LineStyle = xlNone
       
        'Apply top and bottom border around the row
        With Intersect(Target.EntireRow, rngPT)
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Color = RGB(130, 161, 216)
                .TintAndShade = 0
                .Weight = xlMedium
            End With
           
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Color = RGB(130, 161, 216)
                .TintAndShade = 0
                .Weight = xlMedium
            End With
           
        End With
    End If

    Application.ScreenUpdating = True

End Sub

 

[Vivek D]

Also, considering there isn't much happening I expected it to apply borders instantaneously. However, it takes a second or 2. Removing of borders is instantaneous.
Can anything be done to speed it up?

 

[Luke M]

Hi Vivek,

Code run near instantly on my machine with a small pivot, so it may be something with your file. Code itself looks pretty good. Calling out inside horizontal means that if you select the last cell in Pivot, it won't clear the very bottom line (as it would be an outside horizontal, not inside), but that's only an issue for 1 cell, so we may not need to worry.

Best practice is to call out the border properties each time to make sure they're what you want...otherwise, XL will use whatever settings were last used by user.

 

[Vivek D]

Got it. Thanks.

 

[HokieDokie]

This is awesome. Is there a way to do this and have the pivot group have outlines *without* having to click? Been trying to box in 1000s of groups in my pivot.