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]
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]