[color=darkblue]Sub[/color] Create_Charts()
[color=green]'previously named Sub X4()[/color]
[color=darkblue]Dim[/color] lTop [color=darkblue]As[/color] [color=darkblue]Long[/color], lCol [color=darkblue]As[/color] [color=darkblue]Long[/color], lColumns [color=darkblue]As[/color] [color=darkblue]Long[/color]
[color=darkblue]Dim[/color] rngXVals [color=darkblue]As[/color] Range
[color=darkblue]Dim[/color] sName [color=darkblue]As[/color] [color=darkblue]String[/color]
[color=darkblue]Const[/color] ChtHeight [color=darkblue]As[/color] [color=darkblue]Long[/color] = 150 [color=green]'Default Chart Height[/color]
Application.ScreenUpdating = [color=darkblue]False[/color]
[color=darkblue]Call[/color] delete_charts [color=green]'Delete all charts on worksheet "Charts"[/color]
[color=darkblue]With[/color] Sheets("Data")
lColumns = .Range("A4").CurrentRegion.Columns.Count
[color=darkblue]If[/color] lColumns < 2 [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
[color=darkblue]Set[/color] rngXVals = .Range("A5", .Range("A" & .Rows.Count).End(xlUp))
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=green]'Add Chart for each data column[/color]
[color=darkblue]For[/color] lCol = 2 [color=darkblue]To[/color] lColumns
sName = Sheets("Data").Cells(4, lCol).Value
[color=green]'Add Chart[/color]
[color=darkblue]With[/color] Sheets("Charts").ChartObjects.Add(1, lTop, 200, ChtHeight)
.Name = sName
[color=darkblue]With[/color] .Chart
[color=green]'Data[/color]
[color=darkblue]With[/color] .SeriesCollection.NewSeries
.XValues = rngXVals
.Values = rngXVals.Offset(, lCol - 1)
[color=darkblue]End[/color] [color=darkblue]With[/color]
.ChartType = xlLine
[color=green]' Chart Formatting[/color]
.HasLegend = [color=darkblue]False[/color]
[color=green]' X Axis[/color]
[color=darkblue]With[/color] .Axes(xlCategory).TickLabels
.AutoScaleFont = [color=darkblue]False[/color]
.NumberFormat = "m/d/yy" [color=green]' "m/yy"[/color]
.Orientation = 45
[color=darkblue]With[/color] .Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=green]'Y Axis[/color]
[COLOR="Red"]Optimize_ScaleY .Axes(xlValue), rngXVals.Offset(, lCol - 1) [/COLOR][color=green]'Optimize scaling[/color]
[color=darkblue]With[/color] .Axes(xlValue).TickLabels
.AutoScaleFont = [color=darkblue]False[/color]
[color=darkblue]With[/color] .Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=green]' ChartTitle[/color]
.HasTitle = [color=darkblue]True[/color]
[color=darkblue]With[/color] .ChartTitle
.Text = sName
.AutoScaleFont = [color=darkblue]False[/color]
[color=darkblue]With[/color] .Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]End[/color] [color=darkblue]With[/color]
lTop = lTop + ChtHeight
[color=darkblue]Next[/color] lCol
[color=darkblue]Call[/color] mov_avg
[color=darkblue]Call[/color] ArrangeMyCharts [color=green]'Position charts[/color]
Application.ScreenUpdating = [color=darkblue]True[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[color=darkblue]Private[/color] [color=darkblue]Sub[/color] delete_charts()
[color=green]'Delete all charts on worksheet "Charts"[/color]
[color=darkblue]Dim[/color] chtObj [color=darkblue]As[/color] ChartObject
[color=darkblue]For[/color] [color=darkblue]Each[/color] chtObj [color=darkblue]In[/color] Sheets("Charts").ChartObjects
chtObj.Delete
[color=darkblue]Next[/color] chtObj
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[color=darkblue]Private[/color] [color=darkblue]Sub[/color] ArrangeMyCharts()
[color=darkblue]Dim[/color] iChart [color=darkblue]As[/color] [color=darkblue]Long[/color]
[color=darkblue]Dim[/color] dTop [color=darkblue]As[/color] [color=darkblue]Double[/color]
[color=darkblue]Dim[/color] dLeft [color=darkblue]As[/color] [color=darkblue]Double[/color]
[color=darkblue]Dim[/color] dHeight [color=darkblue]As[/color] [color=darkblue]Double[/color]
[color=darkblue]Dim[/color] dWidth [color=darkblue]As[/color] [color=darkblue]Double[/color]
[color=darkblue]Dim[/color] nColumns [color=darkblue]As[/color] [color=darkblue]Long[/color]
[color=darkblue]With[/color] Sheets("Charts")
d[color=darkblue]To[/color]p = .Range("R2") [color=green]' top of first row of charts[/color]
dLeft = .Range("S2") [color=green]' left of first column of charts[/color]
dHeight = .Range("T2") [color=green]' height of all charts[/color]
dWidth = .Range("U2") [color=green]' width of all charts[/color]
nColumns = .Range("V2") [color=green]' number of columns of charts[/color]
[color=darkblue]For[/color] iChart = 1 To .ChartObjects.Count
[color=darkblue]With[/color] .ChartObjects(iChart)
.Height = dHeight
.Width = dWidth
.[color=darkblue]To[/color]p = dTop + Int((iChart - 1) / nColumns) * dHeight
.Left = dLeft + ((iChart - 1) Mod nColumns) * dWidth
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]Next[/color]
[color=darkblue]End[/color] [color=darkblue]With[/color]
End [color=darkblue]Sub[/color]
[color=darkblue]Sub[/color] range_update()
[color=darkblue]Dim[/color] lChartCount [color=darkblue]As[/color] [color=darkblue]Long[/color], lCol [color=darkblue]As[/color] [color=darkblue]Long[/color]
[color=darkblue]Dim[/color] rngXVals [color=darkblue]As[/color] Range
lChartCount = Sheets("Charts").ChartObjects.Count
[color=darkblue]If[/color] lChartCount = 0 [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
[color=darkblue]With[/color] Sheets("Data")
[color=darkblue]Set[/color] rngXVals = .Range("A5", .Range("A" & .Rows.Count).[color=darkblue]End[/color](xlUp))
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]For[/color] lCol = 2 To lChartCount
[color=darkblue]With[/color] Sheets("Charts").ChartObjects(lCol - 1).Chart.SeriesCollection(1)
.XValues = rngXVals
.Values = rngXVals.Offset(, lCol - 1)
[COLOR="Red"]Optimize_ScaleY .Parent.Parent.Axes(xlValue), rngXVals.Offset(, lCol - 1)[/COLOR] [color=green]'Optimize scaling[/color]
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]Next[/color] lCol
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[color=darkblue]Sub[/color] mov_avg()
[color=green]' Procedure to show moving avg for user specified period[/color]
[color=green]' Macro recorded 12/11/2005 by koday[/color]
[color=green]' Cycles through all charts, applies same criteria to each chart[/color]
[color=darkblue]Dim[/color] chtObj [color=darkblue]As[/color] ChartObject
[color=darkblue]Dim[/color] TLine [color=darkblue]As[/color] Trendline
[color=darkblue]Dim[/color] per [color=darkblue]As[/color] [color=darkblue]Integer[/color]
[color=green]' User choices:[/color]
[color=green]' 1. Show data series?[/color]
[color=green]' 2. Moving Avg Period? If <2, no moving avg[/color]
per = [color=darkblue]CInt[/color](Sheets("Charts").Range("P2").Value)
[color=darkblue]For[/color] [color=darkblue]Each[/color] chtObj [color=darkblue]In[/color] Sheets("Charts").ChartObjects
[color=darkblue]With[/color] chtObj.Chart.SeriesCollection(1)
[color=green]' Remove previous trendlines[/color]
[color=darkblue]For[/color] [color=darkblue]Each[/color] TLine [color=darkblue]In[/color] .Trendlines
TLine.Delete
[color=darkblue]Next[/color] TLine
[color=green]' Check to see if period > 1; if yes, add trend line[/color]
[color=darkblue]If[/color] per > 1 [color=darkblue]Then[/color]
[color=green]'**** Set moving Averages[/color]
[color=darkblue]With[/color] .Trendlines.Add(Type:=xlMovingAvg, _
Period:=per, _
Forward:=0, Backward:=0, _
DisplayEquation:=False, _
DisplayRSquared:=False).Border
.ColorIndex = 3
[color=green]'.Weight = xlMedium[/color]
.Weight = xlThin
[color=green]'.LineStyle = xlHairline[/color]
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]End[/color] [color=darkblue]If[/color]
[color=green]' Check to see if data series to be plotted[/color]
[color=darkblue]With[/color] .Border
[color=darkblue]If[/color] Sheets("Charts").Range("Q2") = "Off" [color=darkblue]Then[/color]
[color=green]'.Weight = xlHairline[/color]
.LineStyle = xlNone
[color=darkblue]Else[/color]
[color=green]'.Weight = xlThin[/color]
.LineStyle = xlAutomatic
[color=darkblue]End[/color] [color=darkblue]If[/color]
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]Next[/color] chtObj
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[color=red]Private Sub Optimize_ScaleY(axY As Axis, rngY As Range)
Dim MinScale As Double, MaxScale As Double, Optimizer As Double
axY.MinimumScaleIsAuto = False
axY.MaximumScaleIsAuto = False
With Application.WorksheetFunction
MinScale = .min(rngY)
MaxScale = .max(rngY)
Optimizer = (MaxScale - MinScale) * 0.05
axY.MinimumScale = .RoundDown(MinScale - Optimizer, 1)
axY.MaximumScale = .RoundUp(MaxScale + Optimizer, 1)
End With
End Sub[/COLOR]