Custom date format on chart using VBA

A

artz

Well-known Member
Joined
Aug 11, 2002
Messages
830
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I've got a macro that creates a panel of small charts. The small charts are nice, however, the date axis causes the chart area to get squished. Currently, the date format is the default that the chart creates, 3/10/2012 is an example.

I am thinking that either just 3/12 or or 3/10/12 would work better. The chart formatting section of the code is:

Code: 
With ActiveChart
       .Legend.Delete
       
.Axes(xlCategory).TickLabels.AutoScaleFont = False
With .Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
End With

.Axes(xlValue).TickLabels.AutoScaleFont = False
With .Axes(xlValue).TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
End With

.ChartTitle.AutoScaleFont = False
With .ChartTitle.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
End With

With .SeriesCollection(1).Format.Line

.Weight = xlThin
End With

End With

Does anyone know how to add the date format that I desire to my code?

Thanks,

Art
 
Sort by date Sort by votes
This is your code cleaned up as best I could follow it. All of it can go in one module. I renamed the X4 macro as Create_Charts. "X4" is a cell reference.

Test it on a copy of your data.

Code: 
[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]For[/color] lCol = 2 [color=darkblue]To[/color] lColumns
        
            sName = .Cells(4, lCol).Value
            
            [color=green]'Add Chart for each data column[/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=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]End[/color] [color=darkblue]With[/color]
    
    [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]
    
[color=darkblue]End[/color] [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).End(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=darkblue]End[/color] [color=darkblue]With[/color]
        
    [color=darkblue]Next[/color] lCol
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]


Sub 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
        
End Sub
 
Upvote 0

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Alpha Frog,

That's awesome, thanks for your help! :) I sure had lots of junk that I didn't need or was repeating, hence the formatting then unformatting problem.

The only thing that still doesn't seem to work is the autoscaling. As I mentioned, it works in the standalone worksheet that I found, but not in the Create_Charts code. If it's doing something, I can't see what.

Alternatively, I tried to find an autoscaling sub that I could call from the Create_Charts macro.

I found the following but it won't even compile. I hacked at it but to no avail:

Code: 
Sub AutoScaleYAxes()
Dim ValuesArray(), SeriesValues As Variant
Dim Ctr As Integer, TotCtr As Integer
With ActiveChart
For Each X In .SeriesCollection
SeriesValues = X.Values
ReDim Preserve ValuesArray(1 To TotCtr + UBound(SeriesValues))
For Ctr = 1 To UBound(SeriesValues)
ValuesArray(Ctr + TotCtr) = SeriesValues(Ctr)
Next
TotCtr = TotCtr + UBound(SeriesValues)
Next
.Axes(xlValue).MinimumScaleIsAuto = True
.Axes(xlValue).MaximumScaleIsAuto = True
.Axes(xlValue).MinimumScale = Application.Min(ValuesArray)
.Axes(xlValue).MaximumScale = Application.Max(ValuesArray)
End With
End Sub

Do you see a way to fix this and add it to Create_Charts or call it from that sub?

Thanks so much,

Art
 
Upvote 0
It works for me using the data you previously posted (#10).

On the Data sheet, do you have a value in column A below the data you want to chart? If yes, this may cause the charts to plot blank rows which would force the Autoscale to start at 0 on the Y axis. All the charted data is based on rows A5 to the last used cell in column A.
 
Upvote 0
Alpha Frog,

Thanks for looking at the autoscale macro. Am not sure what you mean "have a value in column A below the data you want to chart?" Data extends down from A5 to A255, however, this number of data rows can vary.

I tried to run the AutoScaleYAxes again. It compiles but returns "Error 91: Object variable or With block variable not set" when I run the sub.

Something is still not right. Were you able to get the AutoScaleYAxes to autoscale all the charts in the panel?

Any suggestions?

Thanks,

Art
 
Upvote 0
artz said:
Thanks for looking at the autoscale macro. Am not sure what you mean "have a value in column A below the data you want to chart?" Data extends down from A5 to A255, however, this number of data rows can vary.

I tried to run the AutoScaleYAxes again. It compiles but returns "Error 91: Object variable or With block variable not set" when I run the sub.

Something is still not right. Were you able to get the AutoScaleYAxes to autoscale all the charts in the panel?
Click to expand...

Yes, all the charts in the panel (using your example data) have the y-axis autoscaled.

Consider that the problem may not be with the autoscale function, but may be with the data or data range.

Say you want it to autoscale from 50 to 100 for example. But you have a blank cell within the data. The Autoscale will see that blank cell as zero and will scale from 0 to 100.

So my previous point was; the charted data is based from row 5 to the last use row in column A. The data can be dynamic in rows size. Not a problem. But say you had something like this for example...
<br />
Book1
ABC
4DateAAAIG
53/10/201115.836.48
63/11/201116.0337.35
73/14/201116.1237.5
83/15/201116.0436.78
93/16/201115.6635.59
103/17/201116.0135.7
113/18/201116.1134.95
12
13
14
15Average:111.77254.35
Sheet1


...the last used row in this case is 15 and the blank rows (yellow) would cause the autoscale to start at 0.

Question: On one of your charts that is not autoscaled correctly, right-click on its y-axis and select Format Axis. On the Scale tab are the autoscale checkboxes checked? If yes, what is the min-max range in the dialog and what min-max range do you want?
 
Upvote 0
Alpha Frog,

Thanks. My data looks good all the way down and past the last used row, nothing extra in subsequent rows.

How are you call the scaling sub? From inside the Create_Charts sub? If so where did you insert it.

I tried running AutoScaleYAxes on its own. I also placed it in the Create_Charts sub and still get the Error 91 problem.

I wonder what I am doing differently if you are getting the autoscale to run.

Any other suggestions?

Thanks,

Art
 
Upvote 0
artz said:
How are you call the scaling sub? /QUOTE]

I'm not calling your scaling sub. I can't replicate your scaling problem. All the charts I create have the autoscaling turned on and look good.

Could we take a step back and not worry about of getting the Sub AutoScaleYAxes to work for the moment. Let's better define the problem first. Scaling is the problem, but Autoscaling may or may not be the issue.

On the Scale tab are the autoscale checkboxes checked? If yes, what is the min-max range in the dialog and what min-max range do you want?
Click to expand...
 
Upvote 0
Hi Alpha Frog,

I am sorry, I was not getting it. Yes, all the charts are set to autoscale. I think then that I am asking for is optimized scaling based on the min and max in the data range for each column.

Previously on a different woksheet, I created an optimized plotting range using the followng in conjunction with some VBA:

Code: 
RangeMax = ROUNDUP(1.05* MAX(M5:M255),0)
RangeMin = ROUNDDOWN(.95* MIN(M5:M255),0)

Seems that I recall that this produced a well readable chart. It's especially important in my current application becuase the charts are small. I could try to find that VBA routine or maybe we could integrate this type of scaling into the scaling routine that I posted earlier.

What do you think?

Thanks,

Art
 
Upvote 0
Wow. We were on two completely different pages.

This is not bullet-proof . Especially if a stock's values only changes less than 0.3 for the whole chart. There may be a more clever way to do this. Don't take my solution as gospel.

Code: 
[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]
 
Upvote 0
Alpha Frog,

You are awesome, thanks! :) The charts are clearly defined with the optimized Y axis; they look great. And yes, the post has grown to two pages, however, it my hope that the help you given to me will help some future person struggling with the same type of need.

It's been a pleasure working with you- I've learned a lot.

Thanks again.

Best Regards,

Art
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
VBA to change Chart fonts on all charts in a sheet
Replies
3
Views
610
Domenic
D
P
  • Question
Turning OFF the visibility of a horizontal (category) axis labels if certain conditions apply
Replies
1
Views
389
NdNoviceHlp
NdNoviceHlp
I
  • Question
Data formatting for Chart
Replies
3
Views
311
IREALLYambatman
I
E
  • Question
Trying to put the chart below Sales Value
Replies
2
Views
188
Eric Penfold
E
E
  • Question
Can anyone help me get my VBA code working? I have spent tons of time but can't quite fix it.
Replies
3
Views
2K
profray
P

Forum statistics

Threads
1,214,641
Messages
6,120,693
Members
448,979
Latest member
DET4492

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top