Refreshing Pivot Tables

[Roger Converse]

I have a macro that I am trying to use on my own spreadsheet. The code is
beow.

My issue is that when the Inputbox appears, the cell range is incorrect.
How can I change the default cell range?


Sub Update_Pivot_Table_Sources()
'
' Macro recorded 5/31/2007 by TB
'
'
Dim iSheets As Integer, x As Integer
Dim iPivot As Integer, _
strCurrentSheet As String, _
strNewPivotTblSrc As String, _
strResponse As String
Dim pt As PivotTable

strResponse = MsgBox("Do you want to change all of the Pivot Table
Sources?", vbOKCancel)

If strResponse < vbOK Then MsgBox ("Cancelled")

If strResponse = vbOK Then

'see if the user selected a pivot table. if so, assign it to pt and
'get the source

On Error GoTo NoPivotSelected
Set pt = ActiveCell.PivotTable
CurPivotTblSrc = pt.SourceData
GoTo Found_Pivot_Source

'if the user didn't select a pivot, see if there is one on the active
'sheet.

'If so, use that. If not, return an error and exit

NoPivotSelected:
Resume RightHere
RightHere:

On Error GoTo Error_Need_Pivot_Source
CurPivotTblSrc = ActiveSheet.PivotTables(1).SourceData
GoTo Found_Pivot_Source

Found_Pivot_Source:

strNewPivotTblSrc = InputBox("Please enter the new source for the" _
& " pivot table below", "New Pivot Source", CurPivotTblSrc)

If strNewPivotTblSrc = "" Then
MsgBox ("Cancelled")
GoTo Exit_Update_All_Pivots
End If

strResponse = MsgBox("Do you want to update all pivots (click Yes) or" _
& " just pivot tables with this data source: " _
& CurPivotTableSrc & " (click no)", vbYesNo)

On Error GoTo Error_Found

Application.ScreenUpdating = False

'Count number of sheets in workbook
iSheets = ActiveWorkbook.Sheets.Count

'remember current sheet
strCurrentSheet = ActiveSheet.Name

If Windows.Count = 0 Then _
GoTo Exit_Update_All_Pivots

For x = 1 To iSheets

'go to a worksheet to change pivot tables
Sheets(x).Activate

'turn warning messages off
Application.DisplayAlerts = False

'change all pivot tables on
'this worksheet one at a time
For Each pt In ActiveSheet.PivotTables

If strResponse = vbNo Then
If pt.SourceData = CurPivotTblSrc Then
pt.SourceData = strNewPivotTblSrc
ActiveWorkbook.ShowPivotTableFieldList = False
End If
Else
pt.SourceData = strNewPivotTblSrc
ActiveWorkbook.ShowPivotTableFieldList = False
End If
Next

'turn warning messages on
Application.DisplayAlerts = True
Next

'return to worksheet that you were originally at
Application.ActiveWorkbook.Sheets(strCurrentSheet).Activate

MsgBox ("Pivots updated successfully.")

End If

GoTo Exit_Update_All_Pivots

Error_Found:

MsgBox ("Error Found. Macro ending. " & Err & ": " & Error(Err))
GoTo Exit_Update_All_Pivots

Error_Need_Pivot_Source:
MsgBox ("Cannot find pivot table. Please select a sheet with a pivot and
re-run macro")
GoTo Exit_Update_All_Pivots

Exit_Update_All_Pivots:
Application.CommandBars("PivotTable").Visible = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub

 

[Roger Converse]

Anyone? I would really like to get this going if possible.