How to set chart Axis values

R

Rasm

Well-known Member
Joined
Feb 9, 2011
Messages
505
Below is code - incuding an array to automatically make the two charts :
1) Normal Histogram
2) The same data but now using .charttype XYscatterwithsmooth

The problem is that I want the X axis from the true histogram to show up on my "Curve Histogram" (In other words I want the exact same scale and values) - however I cannot figure out how to get the X Axis right on my "Curve Histogram". A special thank you to AlphaFrog for getting my the curve Histrogram to work in the first place.

Simply run the macro - ' AddHistoChart' and both charts will be shown

Code: 
Option Explicit
Public Sub AddHistochart()
    Dim NumCharts As Long
    Dim PlotValues() As Variant
    Dim i as Long, ii As Long
    Dim frequency() As Variant
    Dim binlabel() As Variant
    Dim binsize As Variant
    Dim minimumX As Single
    Dim maximumX As Single
    Dim NumBins As Long
    Dim NumParameters As Long
    Dim HighFrequency As Long
    
    Application.StatusBar = "Making Histogram"
    NumBins = 10
    NumParameters = 1
    
   
    ReDim frequency(1 To NumBins)
    ReDim binlabel(1 To NumBins)
    
    Call GetArrayValue(PlotValues, minimumX, maximumX)
    binsize = (maximumX - minimumX) / NumBins
    For i = 1 To NumBins
        binlabel(i) = Format(minimumX + 0.5 * binsize + (i - 1) * binsize, "####0.00")
    Next i
    HighFrequency = 0
    For i = 1 To NumBins - 1
        For ii = 0 To UBound(PlotValues)
            If PlotValues(ii) >= binlabel(i) - 0.5 * binsize And PlotValues(ii) < binlabel(i + 1) - 0.5 * binsize Then
                frequency(i) = frequency(i) + 1
                If frequency(i) > HighFrequency Then HighFrequency = frequency(i)
            End If
        Next ii
    Next i
    '******* last bin
    For i = 0 To UBound(PlotValues)
        If PlotValues(i) >= binlabel(NumBins) - 0.5 * binsize And PlotValues(i) < maximumX Then
            frequency(NumBins) = frequency(NumBins) + 1
            If frequency(NumBins) > HighFrequency Then HighFrequency = frequency(i)
        End If
    Next i
    NumCharts = ActiveSheet.ChartObjects.Count
    If NumCharts > 0 Then
        For i = NumCharts To 1 Step -1
            ActiveSheet.ChartObjects(i).Delete
        Next i
    End If
    
StartMakingCharts:
    
    ActiveSheet.ChartObjects.Add Left:=50, Top:=50, Width:=600, Height:=300
    NumCharts = ActiveSheet.ChartObjects.Count
    If NumCharts > 1 Then
        ActiveSheet.ChartObjects(NumCharts).Left = ActiveSheet.ChartObjects(NumCharts - 1).Left
        ActiveSheet.ChartObjects(NumCharts).Top = ActiveSheet.ChartObjects(NumCharts - 1).Top + ActiveSheet.ChartObjects(NumCharts - 1).Height + 20
        ActiveSheet.ChartObjects(NumCharts).Height = ActiveSheet.ChartObjects(NumCharts - 1).Height
        ActiveSheet.ChartObjects(NumCharts).Width = ActiveSheet.ChartObjects(NumCharts - 1).Width
    End If
    NumCharts = ActiveSheet.ChartObjects.Count
    ActiveSheet.ChartObjects(NumCharts).Activate
    Dim Achart As ChartObject
    Set Achart = ActiveSheet.ChartObjects(NumCharts)
    
    With Achart.Chart     'Set chart properties
       If NumCharts = 1 Then
                .ChartType = xlColumnClustered
            Else
                .ChartType = xlXYScatterSmoothNoMarkers
        End If
        .SeriesCollection.NewSeries
        .HasLegend = False
        .Axes(xlCategory).MajorTickMark = xlTickMarkOutside
        .Axes(xlValue).MajorTickMark = xlTickMarkOutside
        .Axes(xlValue).MinimumScale = 0
        .Axes(xlValue).MaximumScale = HighFrequency + 1
        
        
        .SeriesCollection(NumParameters).Values = Array(frequency) ' creates bars
        .SeriesCollection(NumParameters).XValues = Array(binlabel)
       
      
        'Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=4, Degree:=0.231372549019608
        
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Characters.Text = "Predictions"
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Characters.Text = "Frequency"
    End With
    Set Achart = Nothing
    
    If NumCharts = 1 Then GoTo StartMakingCharts
    
    Application.StatusBar = "Completed ---- Making Histogram/Curve Histogram - Start new Task"
End Sub
 
 
Private Sub GetArrayValue(PlotValues, minimumX, maximumX)
Dim NumObvs As Long
NumObvs = 178
minimumX = 9.1
maximumX = 14
ReDim PlotValues(NumObvs)
PlotValues(0) = 10.406
PlotValues(1) = 10.496
PlotValues(2) = 10.3
PlotValues(3) = 10.469
PlotValues(4) = 10.381
PlotValues(5) = 10.148
PlotValues(6) = 10.306
PlotValues(7) = 10.457
PlotValues(8) = 9.893
PlotValues(9) = 9.881
PlotValues(10) = 9.44
PlotValues(11) = 9.276
PlotValues(12) = 9.162
PlotValues(13) = 9.721
PlotValues(14) = 9.61
PlotValues(15) = 9.804
PlotValues(16) = 9.794
PlotValues(17) = 10.27
PlotValues(18) = 10.416
PlotValues(19) = 10.571
PlotValues(20) = 10.793
PlotValues(21) = 11.061
PlotValues(22) = 11.28
PlotValues(23) = 11.472
PlotValues(24) = 11.527
PlotValues(25) = 11.809
PlotValues(26) = 11.962
PlotValues(27) = 12.141
PlotValues(28) = 12.328
PlotValues(29) = 12.49
PlotValues(30) = 12.677
PlotValues(31) = 12.871
PlotValues(32) = 12.951
PlotValues(33) = 13.15
PlotValues(34) = 13.305
PlotValues(35) = 13.272
PlotValues(36) = 13.168
PlotValues(37) = 13.457
PlotValues(38) = 13.411
PlotValues(39) = 13.613
PlotValues(40) = 13.651
PlotValues(41) = 13.91
PlotValues(42) = 11.053
PlotValues(43) = 11.176
PlotValues(44) = 11.153
PlotValues(45) = 11.902
PlotValues(46) = 11.111
PlotValues(47) = 11.316
PlotValues(48) = 11.839
PlotValues(49) = 11.633
PlotValues(50) = 11.752
PlotValues(51) = 11.709
PlotValues(52) = 11.868
PlotValues(53) = 12.061
PlotValues(54) = 12.223
PlotValues(55) = 12.164
PlotValues(56) = 12.308
PlotValues(57) = 12.541
PlotValues(58) = 12.389
PlotValues(59) = 12.697
PlotValues(60) = 12.722
PlotValues(61) = 12.458
PlotValues(62) = 12.888
PlotValues(63) = 12.999
PlotValues(64) = 12.072
PlotValues(65) = 12.953
PlotValues(66) = 11.03
PlotValues(67) = 11.192
PlotValues(68) = 11.086
PlotValues(69) = 11.197
PlotValues(70) = 11.236
PlotValues(71) = 11.324
PlotValues(72) = 11.696
PlotValues(73) = 11.732
PlotValues(74) = 11.943
PlotValues(75) = 12.113
PlotValues(76) = 12.17
PlotValues(77) = 12.475
PlotValues(78) = 12.349
PlotValues(79) = 13.006
PlotValues(80) = 12.688
PlotValues(81) = 12.655
PlotValues(82) = 12.869
PlotValues(83) = 13.098
PlotValues(84) = 13.127
PlotValues(85) = 13.146
PlotValues(86) = 13.493
PlotValues(87) = 13.746
PlotValues(88) = 13.729
PlotValues(89) = 13.833
PlotValues(90) = 14.026
PlotValues(91) = 13.958
PlotValues(92) = 11.208
PlotValues(93) = 11.098
PlotValues(94) = 11.4
PlotValues(95) = 11.221
PlotValues(96) = 11.22
PlotValues(97) = 11.191
PlotValues(98) = 10.946
PlotValues(99) = 11.353
PlotValues(100) = 11.274
PlotValues(101) = 11.361
PlotValues(102) = 11.173
PlotValues(103) = 11.034
PlotValues(104) = 10.986
PlotValues(105) = 11.025
PlotValues(106) = 10.88
PlotValues(107) = 10.862
PlotValues(108) = 10.852
PlotValues(109) = 11.185
PlotValues(110) = 10.71
PlotValues(111) = 10.83
PlotValues(112) = 10.961
PlotValues(113) = 10.71
PlotValues(114) = 10.895
PlotValues(115) = 10.66
PlotValues(116) = 10.712
PlotValues(117) = 10.86
PlotValues(118) = 10.777
PlotValues(119) = 10.779
PlotValues(120) = 10.596
PlotValues(121) = 10.754
PlotValues(122) = 10.488
PlotValues(123) = 10.829
PlotValues(124) = 10.667
PlotValues(125) = 10.527
PlotValues(126) = 10.378
PlotValues(127) = 10.188
PlotValues(128) = 10.566
PlotValues(129) = 10.468
PlotValues(130) = 10.488
PlotValues(131) = 10.389
PlotValues(132) = 10.188
PlotValues(133) = 10.29
PlotValues(134) = 10.313
PlotValues(135) = 10.289
PlotValues(136) = 10.214
PlotValues(137) = 10.194
PlotValues(138) = 10.126
PlotValues(139) = 10.125
PlotValues(140) = 10.071
PlotValues(141) = 10.248
PlotValues(142) = 10.157
PlotValues(143) = 10.242
PlotValues(144) = 10.128
PlotValues(145) = 10.028
PlotValues(146) = 10.304
PlotValues(147) = 10.092
PlotValues(148) = 10.038
PlotValues(149) = 9.995
PlotValues(150) = 10.132
PlotValues(151) = 10.131
PlotValues(152) = 9.857
PlotValues(153) = 10.22
PlotValues(154) = 9.977
PlotValues(155) = 10.135
PlotValues(156) = 10.181
PlotValues(157) = 10.042
PlotValues(158) = 9.988
PlotValues(159) = 10.151
PlotValues(160) = 10.108
PlotValues(161) = 10.16
PlotValues(162) = 10.088
PlotValues(163) = 10.224
PlotValues(164) = 10.078
PlotValues(165) = 10.05
PlotValues(166) = 9.901
PlotValues(167) = 9.915
PlotValues(168) = 9.988
PlotValues(169) = 9.999
PlotValues(170) = 10.005
PlotValues(171) = 9.962
PlotValues(172) = 9.971
PlotValues(173) = 10.075
PlotValues(174) = 9.989
PlotValues(175) = 10.015
PlotValues(176) = 10.086
PlotValues(177) = 10.172
 
End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
You want to make a Line type chart (with smoothed lines) instead of an XY Scatter type chart.

The Line type chart uses category labels on the X axis like a Column type chart. The XY Scater chart type uses sequential values on the X-axis. This site explains the difference better than I can.
http://pubs.logicalexpressions.com/pub0009/LPMArticle.asp?ID=190

Code: 
With Achart.Chart     'Set chart properties
       If NumCharts = 1 Then
                .ChartType = xlColumnClustered
                
            Else
                [COLOR="Green"]'.ChartType = xlXYScatterSmoothNoMarkers[/COLOR]
                [COLOR="Red"].ChartType = xlLine[/COLOR]
        End If
        .SeriesCollection.NewSeries
        .HasLegend = False
        .Axes(xlCategory).MajorTickMark = xlTickMarkOutside
        .Axes(xlValue).MajorTickMark = xlTickMarkOutside
        .Axes(xlValue).MinimumScale = 0
        .Axes(xlValue).MaximumScale = HighFrequency + 1
        
        
        .SeriesCollection(NumParameters).Values = Array(frequency) ' creates bars
        .SeriesCollection(NumParameters).XValues = Array(binlabel)
        
       [COLOR="Red"]If .ChartType = xlLine Then .SeriesCollection(NumParameters).Smooth = True[/COLOR]
        
        'Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=4, Degree:=0.231372549019608
        
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Characters.Text = "Predictions"
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Characters.Text = "Frequency"
    End With
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question
Histogram - how to do curve overlay
Replies
6
Views
1K
Rasm
R
B
  • Question
VBA read min & max values per sheet range to set primary and secondary axis chart
2
Replies
11
Views
4K
bastian18
B
R
  • Question
Chart error
Replies
7
Views
612
Rasm
R

Forum statistics

Threads
1,214,838
Messages
6,121,885
Members
449,057
Latest member
Moo4247

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