D
DavidH56
Hi,
I used the macro recorder to create a bar chart. I would like assistance to
simplyfy or make the code more efficient. I've listed the code below.
Thanks in adbance for your assistance:
Sub CreateWIPChart()
Sheets.Add.Name = "List"
Sheets("WIPCON").Select
Columns("H:H").Select
Selection.Copy
Sheets("List").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("A:A").EntireColumn.AutoFit
Sheets("WIPCON").Select
Columns("E:E").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("B:B").EntireColumn.AutoFit
'Macro3
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"List!R1C1:R938C2").CreatePivotTable TableDestination:="",
TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable1").AddDataField
ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("SUPV"), "Count of SUPV", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields("SUPV")
.Orientation = xlRowField
.Position = 1
End With
'Macro7
Range("A5:B5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add.Name = "Chart"
Range("A2").Select
ActiveSheet.Paste
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("E13").Select
Sheets("Chart").Select
Charts.Add
ActiveChart.ChartType = xlBarClustered
ActiveChart.SetSourceData Source:=Sheets("Chart").Range("A2:B31"),
PlotBy _
:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet2"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Supervisors SRV WIPCON"
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
With ActiveChart
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = True
End With
ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
ActiveChart.HasLegend = False
ActiveChart.ChartArea.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold Italic"
.Size = 11
End With
'Macro9
ActiveSheet.Shapes("Chart 1").ScaleHeight 1.37, msoFalse, _
msoScaleFromBottomRight
ActiveSheet.Shapes("Chart 1").ScaleHeight 2.17, msoFalse,
msoScaleFromTopLeft
With ActiveChart.PageSetup
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.ChartSize = xlFullPage
.PrintQuality = 600
.Orientation = xlPortrait
End With
ActiveChart.ChartArea.Copy
ActiveWindow.Visible = False
Sheets.Add
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "BarChart"
Range("A2").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects("Chart 1").Activate
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold Italic"
.Size = 8
End With
ActiveChart.ChartTitle.Select
ActiveChart.PlotArea.Select
ActiveChart.Axes(xlValue).MajorGridlines.Select
ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).ApplyDataLabels AutoText:=True,
LegendKey:= _
False, ShowSeriesName:=False, ShowCategoryName:=False,
ShowValue:=True, _
ShowPercentage:=False, ShowBubbleSize:=False
ActiveChart.PlotArea.Select
ActiveChart.ChartArea.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold Italic"
.Size = 9
End With
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold Italic"
.Size = 8
End With
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Range("J15").Select
'Macro10
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
With Selection.Interior
.ColorIndex = 35
.PatternColorIndex = 1
.Pattern = xlSolid
End With
'Macro12
Range("I3").Select
ActiveWindow.DisplayGridlines = False
Range("I10").Select
HideThem
End Sub
Sub HideThem()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If sh.Name = "Chart" Or sh.Name = "Sheet2" _
Or sh.Name = "List" Then sh.Visible = False
Next sh
End Sub
I used the macro recorder to create a bar chart. I would like assistance to
simplyfy or make the code more efficient. I've listed the code below.
Thanks in adbance for your assistance:
Sub CreateWIPChart()
Sheets.Add.Name = "List"
Sheets("WIPCON").Select
Columns("H:H").Select
Selection.Copy
Sheets("List").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("A:A").EntireColumn.AutoFit
Sheets("WIPCON").Select
Columns("E:E").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("B:B").EntireColumn.AutoFit
'Macro3
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"List!R1C1:R938C2").CreatePivotTable TableDestination:="",
TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable1").AddDataField
ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("SUPV"), "Count of SUPV", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields("SUPV")
.Orientation = xlRowField
.Position = 1
End With
'Macro7
Range("A5:B5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add.Name = "Chart"
Range("A2").Select
ActiveSheet.Paste
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("E13").Select
Sheets("Chart").Select
Charts.Add
ActiveChart.ChartType = xlBarClustered
ActiveChart.SetSourceData Source:=Sheets("Chart").Range("A2:B31"),
PlotBy _
:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet2"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Supervisors SRV WIPCON"
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
With ActiveChart
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = True
End With
ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
ActiveChart.HasLegend = False
ActiveChart.ChartArea.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold Italic"
.Size = 11
End With
'Macro9
ActiveSheet.Shapes("Chart 1").ScaleHeight 1.37, msoFalse, _
msoScaleFromBottomRight
ActiveSheet.Shapes("Chart 1").ScaleHeight 2.17, msoFalse,
msoScaleFromTopLeft
With ActiveChart.PageSetup
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.ChartSize = xlFullPage
.PrintQuality = 600
.Orientation = xlPortrait
End With
ActiveChart.ChartArea.Copy
ActiveWindow.Visible = False
Sheets.Add
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "BarChart"
Range("A2").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects("Chart 1").Activate
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold Italic"
.Size = 8
End With
ActiveChart.ChartTitle.Select
ActiveChart.PlotArea.Select
ActiveChart.Axes(xlValue).MajorGridlines.Select
ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).ApplyDataLabels AutoText:=True,
LegendKey:= _
False, ShowSeriesName:=False, ShowCategoryName:=False,
ShowValue:=True, _
ShowPercentage:=False, ShowBubbleSize:=False
ActiveChart.PlotArea.Select
ActiveChart.ChartArea.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold Italic"
.Size = 9
End With
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold Italic"
.Size = 8
End With
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Range("J15").Select
'Macro10
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
With Selection.Interior
.ColorIndex = 35
.PatternColorIndex = 1
.Pattern = xlSolid
End With
'Macro12
Range("I3").Select
ActiveWindow.DisplayGridlines = False
Range("I10").Select
HideThem
End Sub
Sub HideThem()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If sh.Name = "Chart" Or sh.Name = "Sheet2" _
Or sh.Name = "List" Then sh.Visible = False
Next sh
End Sub