To Apply formula in Pivot column

Alka Bajaj · Dec 29th 2011

Re: To Apply formula in Pivot column

Just checked this sample file , it works perfectly fine.

Let me see, why is it not happening in the original file.

Will keep u posted tommorrow in this. Thanks a ton again.

Cheers,
Alka

Alka Bajaj · Dec 30th 2011

Re: To Apply formula in Pivot column

Hi Rory,

Still gets the error. I have increased the pivot size in the sample workbook and run the macro. Get the below error.
Attached the file for your reference.
Run-time error- 1004
Application defined or object defined error.

Also, wrt # 2. I need to run the code again everytime? What is worksheet's pivottableupdate event ? Is it a normal pivot refresh?
Regards,
Alka

Alka Bajaj · Dec 30th 2011

Re: To Apply formula in Pivot column

Please refer the sample file with run time error.

Alka Bajaj · Dec 30th 2011

Re: To Apply formula in Pivot column

Hi Rory,

Also, one more thing..
Everytime I refresh the pivots, the cell formating is gone. I need to maintain this cell formating as below.
1. Cell color should be white
2. Cell format should be " Wrap Text"

How can I code that.

Regards,
Alka

**rory** · Dec 30th 2011

Re: To Apply formula in Pivot column

Which cell formatting?
This seems to be one of those expanding questions...

**rory** · Dec 30th 2011

Re: To Apply formula in Pivot column

It wasn't the large table that was the problem, it was the one with no data showing. I've corrected that and added the update code so that when you refresh or alter a pivot table the code will run automatically. See attached.

Alka Bajaj · Dec 30th 2011

Re: To Apply formula in Pivot column

yeah,... was trying to ask something out of the original post. I was asking how to preserve the below formating of the pivot cell, everytime I refresh it is gone.
1. Cell color should be white
2. Cell format should be " Wrap Text"

But you can choose to ignore this in this particular post.

Just help me in the macro error. Really really appreciate the help done so far.

Alka Bajaj · Dec 30th 2011

Re: To Apply formula in Pivot column

Thanks Rory so much, the last cloumn" Request No" adds to the list perfectly.

Do you mean, the code will automatically refresh the above added column if I alter pivot table? Right now it is not.

Regards,
Alka

**rory** · Dec 30th 2011

Re: To Apply formula in Pivot column

Yes - it should do, and does for me.

Alka Bajaj · Jan 5th 2012

Re: To Apply formula in Pivot column

Hi Rory,
With refernece to above solution, how do we remove the old grand total on the newly added column once pivot is altered.

Please refer the attachment.

**rory** · Jan 5th 2012

Re: To Apply formula in Pivot column

Change ProcessPivot to:

Code

Sub ProcessPivot(pvt As Excel.PivotTable)   Dim rngPT             As Excel.Range
   Dim rngFormulas       As Excel.Range
   Dim rngCell           As Excel.Range
   Dim rngReqStart As Excel.Range
   Dim PF                As Excel.PivotField
   Dim lngCol            As Long








   On Error Resume Next
   Set PF = pvt.RowFields("Short Description")
   On Error GoTo 0








   If Not PF Is Nothing Then
      lngCol = PF.LabelRange.Column
      ' get pivot table data range
      Set rngPT = pvt.DataBodyRange
      Set rngFormulas = rngPT.Offset(, rngPT.Columns.Count).Resize(, 1)
      With rngFormulas
         Set rngReqStart = .Offset(-1).Resize(1)
         With rngReqStart
            .Value = "Request No"
            .EntireColumn.Clear
         End With
         If .Rows.Count > 1 Then
            .FormulaR1C1 = "=IF(RC" & lngCol & "="""","""",HYPERLINK(CONCATENATE(""" & mc_strHYPERLINK_BASE & _
                           """,VLOOKUP(RC" & lngCol & ",'Issue Query Risk'!C6:C14,9,FALSE)),VLOOKUP(RC" & lngCol & _
                           ",'Issue Query Risk'!C6:C14,9,FALSE)))"
            .Offset(, -1).Copy
            .PasteSpecial xlPasteFormats
            .Offset(-1, -1).Resize(1).Copy .Offset(-1).Resize(1)
            .Resize(.Rows.Count - 1).Style = "Hyperlink"
            With .Cells(.Count)
               .FormulaR1C1 = "=COUNT(R" & rngFormulas.Row & "C:R[-1]C)"
               .HorizontalAlignment = xlHAlignRight
            End With
         End If
      End With
      ' clean up any blank cells
      For Each rngCell In rngFormulas
         With rngCell
            If .Text = "" Then .ClearContents
         End With
      Next rngCell




   End If
End Sub

Display More

Alka Bajaj · Jan 6th 2012

Re: To Apply formula in Pivot column

Hi Rory,

Thanks again.

But my file is still throwing some errors. Attached the file with the errors. Sample_05012010.zip

Thanks for all the effort & support.

On a separate note, great work to support the nobel cause. Have to sponsor that.

Regards,

**rory** · Jan 6th 2012

Re: To Apply formula in Pivot column

No file...

Alka Bajaj · Jan 6th 2012

Re: To Apply formula in Pivot column

I was waiting for you to be online.
Can I send anywhere in your mail box? It is bit big to be attached.

**rory** · Jan 6th 2012

Re: To Apply formula in Pivot column

Can you not reduce the amount of data in it? I prefer not to give out my email address.

Alka Bajaj · Jan 6th 2012

Re: To Apply formula in Pivot column

Here it goes. Sample_05012012.xlsm

**rory** · Jan 6th 2012

Re: To Apply formula in Pivot column

You said you were getting an error, but there is no mention in that file of any errors? The reason you are not getting the macro run automatically is that you have not implemented the Workbook_SheetPivotTableUpdate code that I provided. I do not see any colour changes when I refresh the table either.

Alka Bajaj · Jan 9th 2012

Re: To Apply formula in Pivot column

When I am add
Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
ProcessPivot Target
End Sub

I get a compile error- "Ambiguous name detected".
Hence did not included it.

Attached the file with the error. PLease refer the ist row for the error.

**rory** · Jan 9th 2012

Re: To Apply formula in Pivot column

You have two ProcessPivot routines in the file, which is why you are getting the error about ambiguous names. You need to remove the older version.
Current version then needs to be amended to:

Code

Sub ProcessPivot(pvt As Excel.PivotTable)    Dim rngPT             As Excel.Range
    Dim rngFormulas       As Excel.Range
    Dim rngCell           As Excel.Range
    Dim rngReqStart As Excel.Range
    Dim PF                As Excel.PivotField
    Dim lngCol            As Long








   On Error Resume Next
   Set PF = pvt.RowFields("Request No")
   On Error GoTo 0








   If Not PF Is Nothing Then
      lngCol = PF.LabelRange.Column
      ' get pivot table data range
      Set rngPT = pvt.DataBodyRange
      Set rngFormulas = rngPT.Offset(, rngPT.Columns.Count).Resize(, 1)
      With rngFormulas
       Set rngReqStart = .Offset(-1).Resize(1)
            With rngReqStart
                .Value = "Request No"
                 With Intersect(ActiveSheet.UsedRange, .EntireColumn)
                  .Resize(.Rows.Count - 1).Offset(1).Clear
                  End With
                End With








         If .Rows.Count > 1 Then
            .FormulaR1C1 = "=IF(RC" & lngCol & "="""","""",HYPERLINK(CONCATENATE(""" & mc_strHYPERLINK_BASE & _
                           """,VLOOKUP(RC" & lngCol & ",'Issue Query Risk'!C2:C2,1,FALSE)),VLOOKUP(RC" & lngCol & ",'Issue Query Risk'!C2:C2,1,FALSE)))"
                           
                                                 
                                      .Offset(, -1).Copy
            .PasteSpecial xlPasteFormats
            .Offset(-1, -1).Resize(1).Copy .Offset(-1).Resize(1)
            .Offset(-1).Resize(1).Value = "Request No"
            .Resize(.Rows.Count - 1).Style = "Hyperlink"
            With .Cells(.Count)
               .FormulaR1C1 = "=COUNT(R" & rngFormulas.Row & "C:R[-1]C)"
               .HorizontalAlignment = xlHAlignRight
            End With
         End If
      End With
      ' clean up any blank cells
      For Each rngCell In rngFormulas
         With rngCell
            If .Text = "" Then .ClearContents
         End With
      Next rngCell




   End If
End Sub

Display More

or just get rid of the merged cells, since they serve no purpose.

To Apply formula in Pivot column

Participate now!

Share