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
You're welcome.

When I said we were on two different pages, I was referring to the understanding of the scaling problem and not the length of the post.
 
Upvote 0

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Hi Alpha Frog,

I hate to drag you back in, however, there was one more thing that I mentioned that would be nice if it were easy. What happens, when the title is added, is that the chart area shrinks. I want to maximize this, again for readability.

I tried to modify the code in the arrange_charts sub to be 85% of the total chart height. I got this number from recording a macro. 85% is pretty much the maximum.
Code: 
        For iChart = 1 To .ChartObjects.Count
            With .ChartObjects(iChart)
                .Height = dHeight
                .Width = dWidth
                .Top = dTop + Int((iChart - 1) / nColumns) * dHeight
                .Left = dLeft + ((iChart - 1) Mod nColumns) * dWidth
                .PlotArea.Height = 0.85 * .Height
            End With
Not surprisingly, I got an error 438 that this method of selection wasn't supported.

Do you have a suggestion for optimizing the chart area based on the chart height specified in cell T2 of the Charts worksheet.

Thanks,

Art
 
Upvote 0
artz said:
Do you have a suggestion for optimizing the chart area based on the chart height specified in cell T2 of the Charts worksheet.
Click to expand...

Do you mean you want to maximize the Plot area to be a large as possible within the Chart area? The Plot area is just the gray plotted data area excluding the title and axis labels.
 
Upvote 0
Hi Alpha Frog,

Yes, that sounds right. For a given chart height, I would like the plotted area to be as large as possible limited on top by the title and limited on the bottom by the date on the x axis. Are we saying the same thing? I think so.

Hopefully we are not on different pages again. :)

Thanks,

Art
 
Upvote 0
Several tweaks throughout.

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] rngX [color=darkblue]As[/color] Range, rngY [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] rngX = .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=darkblue]Set[/color] rngY = rngX.Offset(, lCol - 1)
        
        [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 = rngX
                    .Values = rngY
                [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]
                .Axes(xlValue).MajorGridlines.Border.ColorIndex = 15    [color=green]'   lt.grey plot area grid lines[/color]
                Optimize_ScaleY .Axes(xlValue), rngY [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
                    .AutoScaleFont = [color=darkblue]False[/color]
                    [color=darkblue]With[/color] .Font
                        .Name = "Arial"
                        .FontStyle = "Bold"
                        .Size = 8
                        [color=green]'.ColorIndex = 15[/color]
                    [color=darkblue]End[/color] [color=darkblue]With[/color]
                    .Top = 0
                    [color=green]'.Left = 0[/color]
                    .Text = sName
                [color=darkblue]End[/color] [color=darkblue]With[/color]
                [color=darkblue]With[/color] .PlotArea
                    .Top = 5
                    .Height = 999999
                    .Left = 0
                    .Width = 999999
                    .Interior.Color[color=darkblue]In[/color]dex = 19   [color=green]'light yellow plot area[/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 In 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] rngX [color=darkblue]As[/color] Range, rngY [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] rngX = .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]Set[/color] rngY = rngX.Offset(, lCol - 1)
        [color=darkblue]With[/color] Sheets("Charts").ChartObjects(lCol - 1).Chart.SeriesCollection(1)
            .XValues = rngX
            .Values = rngY
            Optimize_ScaleY .Parent.Parent.Axes(xlValue), rngY [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]C[color=darkblue]In[/color]t[/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 In .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=darkblue]Private[/color] Sub Optimize_ScaleY([color=darkblue]ByRef[/color] axY [color=darkblue]As[/color] Axis, [color=darkblue]ByVal[/color] rngY [color=darkblue]As[/color] Range)
    
    [color=darkblue]Dim[/color] MinScale [color=darkblue]As[/color] [color=darkblue]Double[/color], MaxScale [color=darkblue]As[/color] [color=darkblue]Double[/color], DataHeight [color=darkblue]As[/color] [color=darkblue]Double[/color]

    [color=darkblue]With[/color] Application.WorksheetFunction
        MinScale = .min(rngY)
        MaxScale = .max(rngY)
        DataHeight = MaxScale - MinScale
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    [color=darkblue]With[/color] axY [color=green]'Chart Y-axis[/color]
        .MinimumScaleIsAuto = [color=darkblue]False[/color]
        .MaximumScaleIsAuto = [color=darkblue]False[/color]
        .MinimumScale = MinScale - DataHeight * 0.05
        .MaximumScale = MaxScale + DataHeight * 0.05
        [color=darkblue]With[/color] .TickLabels
            [color=darkblue]Select[/color] [color=darkblue]Case[/color] DataHeight
                [color=darkblue]Case[/color] [color=darkblue]Is[/color] < 0.04: .NumberFormat = "0.000"
                [color=darkblue]Case[/color] [color=darkblue]Is[/color] < 0.4: .NumberFormat = "0.00"
                [color=darkblue]Case[/color] [color=darkblue]Is[/color] < 4: .NumberFormat = "0.0"
                [color=darkblue]Case[/color] Else: .NumberFormat = "0"
            [color=darkblue]End[/color] [color=darkblue]Select[/color]
        End [color=darkblue]With[/color]
    End With
End Sub
 
Upvote 0
Alpha Frog,

Thanks, again. This awesome. The sizing is great and the color scheme makes the charts easy to read. :)

Is the code dynamic in the sense that if I change the chart size for each chart in the panel, that the plot area will adapt correspondingly?

Thanks,

Art
 
Upvote 0
Alpha Frog,

Could I enlist your help for one more chart macro? On another worksheet, I want to compare the percent growth of various stocks. Starting in in column B extending to column Y.

Dates are in column A. Again, like the panel of charts, the data ranges and number of used columns can vary. The percent calculation is based on the values on the Data worksheet which I posted earlier.

Below is an example of the new worsheet named Percent:

Excel Workbook
ABCDEFGHIJK
4DateCOHFASTTPXUAASNAATHNGCOLULUULTAVAL
512/14/2011-0.9%-0.2%-1.8%-0.7%-0.6%-3.1%-1.2%-2.7%-4.8%-1.1%
612/15/2011-2.1%1.0%-1.2%-0.5%-0.1%-18.1%-0.4%0.7%-5.5%-0.2%
712/16/2011-4.1%2.6%2.6%-0.5%3.1%-17.6%0.2%1.0%-5.1%1.0%
812/19/2011-5.2%2.8%-2.1%-3.3%4.1%-19.8%0.3%0.7%-8.1%0.9%
912/20/2011-2.4%7.1%0.6%-2.9%9.0%-17.3%5.2%4.4%-5.2%3.2%
1012/21/2011-0.3%6.8%0.7%-4.5%8.4%-17.7%7.6%2.4%-6.7%3.6%
1112/22/2011-0.5%6.2%5.8%-5.2%6.9%-18.0%6.9%4.4%-9.1%5.7%
1212/23/20111.9%8.2%4.9%-1.7%7.3%-17.6%7.2%6.9%-6.2%6.7%
1312/27/20112.8%8.7%3.2%-1.0%8.7%-17.8%8.9%8.5%-7.2%5.9%
1412/28/20111.3%8.4%0.8%-2.6%6.6%-17.5%6.9%5.1%-9.2%6.2%
1512/29/20112.5%9.8%4.8%-3.5%8.7%-16.3%8.1%5.0%-8.4%7.7%
1612/30/20111.6%8.0%2.3%-3.6%7.5%-18.0%6.9%4.1%-8.1%7.8%
171/3/20120.0%8.4%7.5%-3.1%8.5%-16.4%1.5%5.0%-9.2%8.5%
181/4/20122.5%9.9%9.1%-2.4%11.6%-15.7%5.0%14.1%-6.0%10.0%
191/5/20123.0%11.8%13.4%-1.7%17.9%-11.9%9.3%16.3%-1.5%10.4%
201/6/20124.3%12.0%14.0%-0.4%17.1%-11.2%7.3%19.8%-1.6%11.9%
211/9/20124.7%11.9%13.1%-0.1%20.8%-9.6%7.3%19.3%-1.0%10.7%
221/10/20123.8%11.5%13.0%0.9%21.7%-9.7%6.5%33.6%-0.2%13.1%
231/11/20121.6%12.0%16.0%1.7%21.6%-8.0%6.4%35.2%1.6%13.6%
241/12/20122.1%13.6%16.4%4.3%22.7%-6.6%6.2%36.7%1.9%14.9%
251/13/20123.3%15.4%14.8%3.6%23.4%-9.6%2.5%38.3%3.6%15.8%
261/17/20124.3%15.9%14.1%2.4%25.0%-9.6%3.5%35.4%5.0%15.8%
271/18/20127.5%12.8%18.0%-1.7%27.6%-3.6%3.4%35.0%7.3%17.0%
281/19/20128.2%13.3%22.3%-2.1%27.9%-3.6%3.5%34.2%9.6%17.9%
291/20/20128.0%13.6%19.2%-1.2%28.2%-4.8%3.3%34.2%8.0%16.5%
301/23/20127.0%14.1%17.8%1.7%27.8%-6.4%2.7%39.3%8.9%15.9%
Percent


I need just a simple linechart with all the series that are available in columns B through AY. No markers, thin lines, a legend, and the Y axis is on the right at the maximum date.

Seems that the code that you posted earlier could be easily adapted to do this. Any help is appreciated.

Thanks,

Art
 
Upvote 0
A new question should be in a new thread, and that would let the whole forum have the opportunity to respond.
 
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
633
Domenic
D
P
  • Question
Turning OFF the visibility of a horizontal (category) axis labels if certain conditions apply
Replies
1
Views
406
NdNoviceHlp
NdNoviceHlp
I
  • Question
Data formatting for Chart
Replies
3
Views
325
IREALLYambatman
I
E
  • Question
Trying to put the chart below Sales Value
Replies
2
Views
196
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,215,073
Messages
6,122,970
Members
449,095
Latest member
Mr Hughes

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