T
twaccess
This macro has really worked well in cleaning up and formatting a daily
report I recieve until I added a Pivot table bit to it yesterday. It
worked fine on yesterday's report but not on today's ???
The bit that seems to be causing a problem is in *BOLD*.
Is anyone free to have a look at this and let me know where I'm going
wrong please ?
Sub overview_tidy_up()
Sheets("tw").Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending,
Key2:=Range("A2") _
, Order2:=xlAscending, Key3:=Range("G2"), Order3:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
Selection.AutoFilter
Range("D,E:E,I:I,M:M,R:R,S:S,T:T").Delete xlShiftToLeft
With ActiveSheet.PageSetup
..Orientation = xlLandscape
..Zoom = False
..FitToPagesWide = 1
..FitToPagesTall = 20
End With
'Alternative by keepITcool, amended by Leith Ross
Dim r&, Toggle As Boolean
With ActiveSheet.UsedRange
For r = 1 To .Rows.Count
With .Rows(r).Font
If Toggle Then
..Bold = False
Else
..Bold = True
End If
End With
If .Cells(r, 1) <> .Cells(r + 1, 1) Then Toggle = Not Toggle
Next
End With
Cells.Select
Cells.EntireColumn.AutoFit
Range("A2").Select
ActiveWindow.Zoom = 70
Sheets("tw").Select
Selection.AutoFilter
Selection.AutoFilter Field:=11, Criteria1:="=0",
Operator:=xlAnd
Range("M2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(M2>0,N2<(TODAY()+5))"
Selection.FormatConditions(1).Interior.ColorIndex = 3
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(M2>0,N2<(TODAY()+7))"
Selection.FormatConditions(2).Interior.ColorIndex = 44
Selection.Copy
Columns("M:M").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Columns("G:G").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, _
Formula1:="=""P"""
Selection.FormatConditions(1).Interior.ColorIndex = 3
Range("N2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(N2<(TODAY()+8))"
Selection.FormatConditions(1).Interior.ColorIndex = 3
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(N2<(TODAY()+15))"
Selection.FormatConditions(2).Interior.ColorIndex = 44
Selection.Copy
Range("N2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("A2").Select
Application.CutCopyMode = False
'
' Macro2 Macro
' Macro to create Pivotable
'
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=
_
"tw!R1C1:R557C16").CreatePivotTable TableDestination:="",
TableName:= _
"PivotTable2"
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3,
1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable2").SmallGrid = False
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Project")
..Orientation = xlRowField
..Position = 1
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Name")
..Orientation = xlRowField
..Position = 2
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Prom
Date")
..Orientation = xlRowField
..Position = 3
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Ln")
..Orientation = xlDataField
..Position = 1
End With
*ActiveSheet.PivotTables("PivotTable2").PivotFields("Sum of
Ln").Function = _
xlCount*
Range("A4").Select
ActiveSheet.PivotTables("PivotTable2").PivotFields("Project").Subtotals
= Array _
(False, False, False, False, False, False, False, False, False,
False, False, False)
Range("B4").Select
ActiveSheet.PivotTables("PivotTable2").PivotFields("Name").Subtotals =
Array( _
False, False, False, False, False, False, False, False, False,
False, False, False)
Columns("A").Select
Columns("A").EntireColumn.AutoFit
End Sub
report I recieve until I added a Pivot table bit to it yesterday. It
worked fine on yesterday's report but not on today's ???
The bit that seems to be causing a problem is in *BOLD*.
Is anyone free to have a look at this and let me know where I'm going
wrong please ?
Sub overview_tidy_up()
Sheets("tw").Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending,
Key2:=Range("A2") _
, Order2:=xlAscending, Key3:=Range("G2"), Order3:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
Selection.AutoFilter
Range("D,E:E,I:I,M:M,R:R,S:S,T:T").Delete xlShiftToLeft
With ActiveSheet.PageSetup
..Orientation = xlLandscape
..Zoom = False
..FitToPagesWide = 1
..FitToPagesTall = 20
End With
'Alternative by keepITcool, amended by Leith Ross
Dim r&, Toggle As Boolean
With ActiveSheet.UsedRange
For r = 1 To .Rows.Count
With .Rows(r).Font
If Toggle Then
..Bold = False
Else
..Bold = True
End If
End With
If .Cells(r, 1) <> .Cells(r + 1, 1) Then Toggle = Not Toggle
Next
End With
Cells.Select
Cells.EntireColumn.AutoFit
Range("A2").Select
ActiveWindow.Zoom = 70
Sheets("tw").Select
Selection.AutoFilter
Selection.AutoFilter Field:=11, Criteria1:="=0",
Operator:=xlAnd
Range("M2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(M2>0,N2<(TODAY()+5))"
Selection.FormatConditions(1).Interior.ColorIndex = 3
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(M2>0,N2<(TODAY()+7))"
Selection.FormatConditions(2).Interior.ColorIndex = 44
Selection.Copy
Columns("M:M").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Columns("G:G").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, _
Formula1:="=""P"""
Selection.FormatConditions(1).Interior.ColorIndex = 3
Range("N2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(N2<(TODAY()+8))"
Selection.FormatConditions(1).Interior.ColorIndex = 3
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(N2<(TODAY()+15))"
Selection.FormatConditions(2).Interior.ColorIndex = 44
Selection.Copy
Range("N2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("A2").Select
Application.CutCopyMode = False
'
' Macro2 Macro
' Macro to create Pivotable
'
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=
_
"tw!R1C1:R557C16").CreatePivotTable TableDestination:="",
TableName:= _
"PivotTable2"
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3,
1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable2").SmallGrid = False
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Project")
..Orientation = xlRowField
..Position = 1
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Name")
..Orientation = xlRowField
..Position = 2
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Prom
Date")
..Orientation = xlRowField
..Position = 3
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Ln")
..Orientation = xlDataField
..Position = 1
End With
*ActiveSheet.PivotTables("PivotTable2").PivotFields("Sum of
Ln").Function = _
xlCount*
Range("A4").Select
ActiveSheet.PivotTables("PivotTable2").PivotFields("Project").Subtotals
= Array _
(False, False, False, False, False, False, False, False, False,
False, False, False)
Range("B4").Select
ActiveSheet.PivotTables("PivotTable2").PivotFields("Name").Subtotals =
Array( _
False, False, False, False, False, False, False, False, False,
False, False, False)
Columns("A").Select
Columns("A").EntireColumn.AutoFit
End Sub