VBA code for plotting two separate charts for alternate columns

adventurer

New Member
Joined
Jul 1, 2015
Messages
9
0


Hi,
This is the part of the large data set I have. I want to plot two separate charts for the 'Actual' and '% of total'.


Private Sub CommandButton2_Click()




Dim ChartRange1 As Range
Dim ChartRange2 As Range


StrtRow = 1
StartRow = 3
EndRow = 6


With Sheets("Sheet1")


Set ChartRange1 = Range(Cells(StrtRow, "B"), Cells(EndRow, "B"))
ChartRange1Addr = ChartRange1.Address(External:=True)


Set ChartRange2 = Range(Cells(StrtRow, "C"), Cells(EndRow, "J"))
ChartRange2Addr = ChartRange2.Address(External:=True)
End With


ActiveSheet.Shapes.AddChart.Select


' We set the source data for the chart (y,x)


ActiveChart.SetSourceData Source:=Range( _
ChartRange1Addr & "," & ChartRange2Addr)



'We define the type of chart


ActiveChart.ChartType = xlColumnClustered

' Before we can perform an action on the chart we need to activate it
ActiveSheet.ChartObjects(1).Activate
'We perform the cut operation
ActiveSheet.ChartObjects(1).Cut
'we select the Sheet2 where we wish to paste our chart
Sheets("Sheet2").Select
'We now paste the chart in the Sheet2 whic has become the active sheet after selection
ActiveSheet.Paste
'we return to sheet1
Sheets("Sheet1").Select
' we select the cell F9 in sheet1
Range("F9").Activate


End Sub


This is the code I have. It gives me the Actual and % plots in same chart. I have tried codes for selecting alternate columns and plotting two charts but did not work.





0



This is the chart I got. Kindly suggest me a code to make two separate charts for alternate columns one for 'Actual' and the other for '% of total' values.
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Use code tags to help clarify your code (select the code and click the hash button on the end of the "toolbar" above the entry you're typing).

"' Before we can perform an action on the chart we need to activate it"
This is not true.

You are not creating two charts nor two chart data regions in your code. You create one, cut it (which destroys the original) and paste it elsewhere.

This code sets up the two data ranges, inserts the two charts, arranges them side by side by moving one half its width left, the other half its width right, then populates the charts.

Note that within the With ActiveSheet block, I use .Range and .Cells, signifying ActiveSheet.Range and ActiveSheet.Cells, not the unqualified Range and Cells.

Code:
Sub TwoCharts()
  Dim rChart1 As Range
  Dim rChart2 As Range
  Dim iColumn As Long

  Dim cht1 As Chart
  Dim cht2 As Chart

  Const StrtRow As Long = 1
  Const EndRow As Long = 6

  With ActiveSheet

    Set rChart1 = .Range(.Cells(StrtRow, "B"), .Cells(EndRow, "B"))
    Set rChart2 = .Range(.Cells(StrtRow, "B"), .Cells(EndRow, "B"))

    For iColumn = 3 To 9 Step 2
      Set rChart1 = Union(rChart1, .Range(.Cells(StrtRow, iColumn), .Cells(EndRow, iColumn)))
    Next

    For iColumn = 4 To 10 Step 2
      Set rChart2 = Union(rChart2, .Range(.Cells(StrtRow, iColumn), .Cells(EndRow, iColumn)))
    Next

    Set cht1 = .Shapes.AddChart.Chart
    Set cht2 = .Shapes.AddChart.Chart
    
    With cht1
      .Parent.Left = .Parent.Left - .Parent.Width / 2
      .ChartType = xlColumnClustered
      .SetSourceData rChart1
    End With
    
    With cht2
      .Parent.Left = .Parent.Left + .Parent.Width / 2
      .ChartType = xlColumnClustered
      .SetSourceData rChart2
    End With
    
  End With
End Sub

The result looks like this:

MrExcel-TwoCharts.png
 
Upvote 0
Hi Jon,
Thanks a lot. This code works like a charms. But, I have merged cells in my first row as you can see in my question. So, how to work with that because the second chart would not look like what I want.
 
Upvote 0
This is the first you've mentioned merged cells (I searched the page in the browser). Didn't anyone tell you merged cells are evil?

What cells are merged?
 
Upvote 0
As you can see in the image the cells of the first row are merged (i.e school1, school2, etc.). Anyway, I unmerged them but when I run the code for more no. of columns, it shows series formula too long error. Can you please tell how to correct it?
Thanks.
 
Upvote 0
As I can see in the image? Here's what I see in the image:

MrExcel-BrokenImage.png


But here's what I think it looks like. If cells B1 and B2 are blank, this is also what the output of my code looks like. And it doesn't matter if those pairs of cells are merged or not (I tested both ways.

Incidentally, you get the same appearance without the nastiness of merged cells if cells C1:J1 are formatted with the Center Across Selection horizontal alignment.

MrExcel-TwoChartsPartDeux.png
 
Upvote 0
Hi Jon,
Thanks for the reply. This works but the code is still showing Series formula too long error when I apply it to large data set of same type. Can you guide me on how to remove that error?
 
Upvote 0
Does it draw the charts? What does the series formula look like? (Select a series and look in the formula bar.)

Could you post a link to an uploaded workbook? Or email it to my first name at PeltierTech with a subject like "Mr Excel VBA code for plotting two separate charts for alternate columns".
 
Upvote 0
I've made a couple adjustments to the code I posted last week. I've introduced a constant to make it easier to change the number of columns used in the chart data. I also specified to plot by column, since for larger numbers of columns, Excel would by default plot by rows, and this messes up what is plotted. It also leads to the error reported above if too many discontiguous ranges are specified.

The amended procedure:
Code:
Sub TwoCharts()
  Dim rChart1 As Range
  Dim rChart2 As Range
  Dim iColumn As Long

  Dim cht1 As Chart
  Dim cht2 As Chart

  Const StrtRow As Long = 1
  Const EndRow As Long = 6
  Const ColumnMax As Long = 48

  With ActiveSheet

    Set rChart1 = .Range(.Cells(StrtRow, "B"), .Cells(EndRow, "B"))
    Set rChart2 = .Range(.Cells(StrtRow, "B"), .Cells(EndRow, "B"))

    For iColumn = 3 To ColumnMax - 1 Step 2
      Set rChart1 = Union(rChart1, .Range(.Cells(StrtRow, iColumn), .Cells(EndRow, iColumn)))
    Next

    For iColumn = 4 To ColumnMax Step 2
      Set rChart2 = Union(rChart2, .Range(.Cells(StrtRow, iColumn), .Cells(EndRow, iColumn)))
    Next

    Set cht1 = .Shapes.AddChart.Chart
    Set cht2 = .Shapes.AddChart.Chart
    
    With cht1
      .Parent.Left = .Parent.Left - .Parent.Width / 2
      .ChartType = xlColumnClustered
      .SetSourceData rChart1, xlColumns
    End With
    
    With cht2
      .Parent.Left = .Parent.Left + .Parent.Width / 2
      .ChartType = xlColumnClustered
      .SetSourceData rChart2, xlColumns
    End With
    
  End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

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