Add Button to New Sheet on Pivot Table Double Click

[rickincanada]

I have a pivot table (built in excel 2003) which I instruct users to double-click on to get more data. When they double click this creates a new worksheet displaying the source data to that row on pivot table (obvious, i know, right ).
My issue is that for most users this confuses them and they can't figure out how to get back to the Pivot Table.

What I want to do is place a big button on the newly created sheet that deletes the active sheet and returns them to the pivot table. Is this possible?

I'm fairly familiar with VBA so even a point in the right direction should help!

Thanks,
Rick

 

[rickincanada]

Okay,so I've been digging around on this and have a macro to create my button and insert my code. I'm struggling now though to figure out how to run this code...

Here's what I have (not working):

'On Pivot Table
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 11 Then '11th column is the values column
Call AddButton
End If
End Sub

'macro to add button
Sub AddButton()
Application.Wait (Now() + "00:00:02")
If ActiveSheet.Name <> "Traffic Log" Then 'pivot table sheet is Traffic Log
Call AddButtonAndCode
End If
End Sub

I can't even seam to get to wait! Please help!

Thanks,
Rick

 

[rickincanada]

Well not a lot of help from the forum on this one!

Anyhow, in the event someone else is looking to do this in the future I'll post what I ended up with:

To begin I learned that I needed to use the Workbook_NewSheet event to begin my process.

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Call AddButton
End Sub

As you can see I then added a macro that checked to see if the sheet we were on was NOT the Pivot Table and then if it wasn't proceeded to add our object:

Sub AddButton()
If ActiveSheet.Name <> "Traffic Log" Then
Call AddButtonAndCode
End If
End Sub

If we're not on the Pivot Table then we proceed with our next macro which creates the object (button) and the code that lives behind it:

Sub AddButtonAndCode()
Application.ScreenUpdating = False
ActiveSheet.Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.RowHeight = 31.5
Range("A2").Select
' Declare variables
Dim i As Long, Hght As Long
Dim Name As String, NName As String
' Set the button properties
i = 0
Hght = 305.25
' Set the name for the button
NName = "cmdAction" & i
' Test if there is a button already and if so, increment its name
For Each OLEObject In ActiveSheet.OLEObjects
If Left(OLEObject.Name, 9) = "cmdAction" Then
Name = Right(OLEObject.Name, Len(OLEObject.Name) - 9)
If Name >= i Then
i = Name + 1
End If
NName = "cmdAction" & i
Hght = Hght + 27
End If
Next
' Add button
Dim myCmdObj As OLEObject, N%
Set myCmdObj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, Left:=3, Top:=3, Width:=130, Height:= _
26)
' Define buttons name
myCmdObj.Name = NName
' Define buttons caption
myCmdObj.Object.Caption = "RETURN TO REPORT"
' Inserts code for the button
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
N = .CountOfLines
.InsertLines N + 1, "Private Sub " & NName & "_Click()"
.InsertLines N + 2, vbNewLine
.InsertLines N + 3, vbTab & "Call ReturnToPivot" 'here you see I'm calling my final macro
.InsertLines N + 4, vbNewLine
.InsertLines N + 5, "End Sub"
End With

Application.ScreenUpdating = True

End Sub

Then to finish I need to have a macro built with the code that I want to run using my newly created button:

Sub ReturnToPivot()
Application.DisplayAlerts = False
If InStr(ActiveSheet.Name, "Sheet") Then
ActiveSheet.Delete
Else: ActiveSheet.DrawingObjects.Delete
End If
Application.DisplayAlerts = True
End Sub

In this case I was looking to return to the Pivot Table and delete the newly created worksheet. Anyhow, hopefully someone else finds this useful as it took me the better part of the morning work my way through.