PDA

View Full Version : Update Pivot table



Djblois
08-06-2007, 11:59 AM
I created a sub procedure that would add 2 excel data tables togeather and then refresh all the pivot tables in the current workbook. The last part I can't get to work is reformat the table. This is my code:

Sub CombineSheets()
Dim findString As Range
Dim PT As PivotTable
Dim ws As Worksheet

If Not Application.Dialogs(xlDialogOpen).Show Then
End
End If
Set WB(2) = ActiveWorkbook

WB(2).Worksheets(1).Activate

workingSheet.Range("A" & finalrow(workingSheet)).EntireRow.Delete
Range("A2", ActiveCell.SpecialCells(xlLastCell)).Copy workingSheet.Range("A" & finalrow(workingSheet))
workingSheet.Range("A" & finalrow(workingSheet)).EntireRow.Delete

WB(2).Close
WB(1).Names.Add Name:="pvtData", RefersToR1C1:=workingSheet.Cells(1, 1).Resize(finalrow(workingSheet) - 1, FinalColumn(workingSheet))

For Each ws In WB(1).Worksheets
On Error Resume Next
ws.PageSetup.RightHeader = "&""Arial,Bold""&12" & fnCalcTime(workingSheet, 2) 'Update Date
For Each PT In ws.PivotTables
Set workingSheet = ws
PT.RefreshTable
comFixFormatingAfterUpdate
Next PT
Next ws
Range("A2").Activate
WB(1).Save

End Sub


edit: Sorry I forgot to mention this is the part that is not working:

Sub comFixFormatingAfterUpdate()

'Highlight Headers after update
For i = 2 To 4
If workingSheet.Cells(i, 1).Interior.ColorIndex = 5 Or _
workingSheet.Cells(i, FinalColumn(workingSheet)).Interior.ColorIndex = 5 Then
workingSheet.Range(Cells(i, 1), Cells(i, FinalColumn(workingSheet))).Interior.ColorIndex = 5
End If
Next

End Sub

and if you want to see the finalcolumn function:

[vba]Function FinalColumn(ByVal shtToCount As Worksheet) As Long
Dim finalColumnLast As Long, bottomRow As Long, rowTest As Long, columnTest As Long

bottomRow = shtToCount.Cells(Rows.Count, 1).End(xlUp).Row

FinalColumn = shtToCount.Cells(1, Columns.Count).End(xlToLeft).Column
finalColumnLast = shtToCount.Cells(bottomRow, Columns.Count).End(xlToLeft).Column

If finalColumnLast > FinalColumn Then FinalColumn = finalColumnLast

'loop to find Actual Final column
For j = 1 To 2
rowTest = shtToCount.Cells(1, FinalColumn + 1).End(xlDown).Row
columnTest = shtToCount.Cells(rowTest, Columns.Count).End(xlToLeft).Column

If columnTest > FinalColumn Then FinalColumn = columnTest
Next

End Function[vba]

rory
08-07-2007, 01:51 AM
Hi,
You need to change your formatting code to:
Sub comFixFormatingAfterUpdate()

'Highlight Headers after update
With workingsheet
For i = 2 To 4
If .Cells(i, 1).Interior.ColorIndex = 5 Or _
.Cells(i, FinalColumn(workingsheet)).Interior.ColorIndex = 5 Then
.Range(.Cells(i, 1), .Cells(i, FinalColumn(workingsheet))).Interior.ColorIndex = 5
End If
Next
End With

End Sub


You were not qualifying the Cells property as belonging to the workingsheet object in this line:
workingSheet.Range(Cells(i, 1), Cells(i, FinalColumn(workingSheet))).Interior.ColorIndex = 5

Incidentally, in your combine sheets macro, you can move the Set workingSheet = ws line above the For Each PT line since you aren't changing worksheets each pivot table and you are therefore just assigning the same worksheet to workingsheet repeatedly.
Regards,
Rory