Create and output charts to separate worksheets.

C

cccbzg

Board Regular
Joined
Oct 5, 2014
Messages
68
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I'm trying to create a chart for each line in an excel spreadsheet. I've got that part working and looking the way I want it to. Now my problem is to output each chart to a separate worksheet...and I'm stuck. Any help would be appreciated.
Many Thanks,
Bonnie


Sub MacroCHARTIT()

'*********************need to move to next student
Dim i As Integer

' Allow access to file & eliminate flashing of screens
Application.ScreenUpdating = False
Sheets("Chartdata").Visible = True

'
Sheets("Chartdata").Select

With Sheets("Chartdata")
lFinalRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rngColA = .Range(.Cells(1, "A"), .Cells(lFinalRow, "A"))
i = 2

'** For Each cell In rngColA.Cells
For i = 2 To lFinalRow

Rows(i).Select
MsgBox (i)
Range("D2:G2").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=Range("Chartdata!$D$2:$G$2")
ActiveChart.SeriesCollection(1).Name = "=""Your Scores"""
ActiveChart.Legend.Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "=""CLASS"""
ActiveChart.SeriesCollection(2).Values = "=Chartdata!$H$2:$k$2"
' If checktrue = True Then
'Chart Title

Dim TitleIT As String
ActiveChart.SetElement (msoElementChartTitleAboveChart)

TitleIT = Sheet1.Cells(i, "C") & " " & Sheet1.Cells(i, "B")
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).ApplyDataLabels
ActiveChart.SeriesCollection(1).XValues = "=Chartdata!$D$1:$G$1"
ActiveChart.SeriesCollection(2).DataLabels.Select
Selection.Delete

With ActiveChart
.HasTitle = True
.ChartTitle.Text = TitleIT
'******

'
'Change the size of the markers
'
ActiveChart.SeriesCollection(1).Select
With Selection
.MarkerStyle = 2
.MarkerSize = 11
End With

'**** Get rid of lines in line chart
ActiveChart.SeriesCollection(1).Select
Selection.Format.Line.Visible = msoFalse
ActiveChart.SeriesCollection(2).Select
Selection.Format.Line.Visible = msoFalse
' Change ****** marker

'***** COLOR PLOT AREA ****

With ActiveChart.PlotArea.Format.Fill
.Visible = msoTrue
.TwoColorGradient msoGradientHorizontal, 1
.ForeColor.RGB = RGB(0, 166, 53)
.BackColor.RGB = RGB(255, 0, 0)
.GradientStops(1).Position = 0.47
.GradientStops.Item(1).Transparency = 0.8
.GradientStops(2).Position = 0.74
.GradientStops.Item(2).Transparency = 0.8
End With

'****************
'*** Change the color of the markers
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.Transparency = 0
'''
'***************OUTPUT CHART HERE ?
Charts.Add
'ActiveChart.ChartType = xlColumnClustered

'ActiveChart.Location Where:=xlLocationAsNewSheet, Name:='***should be the value of Col B row i (variable)

'
End With

End With



DATA
A B C D E F G H I J K
mean SIDLName HX PXNoteICS
751234566Student 11-1.21.51.350000
751234567Student 20000
751234568Student 3-1.3-0.3-0.7-1
751234569Student 421.31.71.9
751234570Student 533.12.54
751234571
Student 642.52.62.2
751234572Student 7-1-0.71.1-1.3
751234573Student 8-2-1-0.7-1.8
751234574Student 921.31.71.9
751234575Student 102.13.12.54

<colgroup><col><col><col><col span="8"></colgroup><tbody>
</tbody>



<colgroup><col><col><col span="8"></colgroup><tbody>
</tbody>
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
This should work. Changed some of your chart data ranges as I am assuming you want it to change for each row.

Code: 
Sub MacroCHARTIT()


'*********************need to move to next student
Dim i As Integer


' Allow access to file & eliminate flashing of screens
Application.ScreenUpdating = False
Sheets("Chartdata").Visible = True


'
Sheets("Chartdata").Select


With Sheets("Chartdata")
lFinalRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rngColA = .Range(.Cells(1, "A"), .Cells(lFinalRow, "A"))
End With
i = 2


'** For Each cell In rngColA.Cells
For i = 2 To lFinalRow


Rows(i).Select
MsgBox (i)
Range("D" & i & ":G" & i).Select 'Changed
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=Range("Chartdata!D" & i & ":G" & i) 'Changed
ActiveChart.SeriesCollection(1).Name = "=""Your Scores"""
ActiveChart.Legend.Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "=""CLASS"""
ActiveChart.SeriesCollection(2).Values = ("=Chartdata!H" & i & ":K" & i) 'Changed
' If checktrue = True Then
'Chart Title


Dim TitleIT As String
ActiveChart.SetElement (msoElementChartTitleAboveChart)


TitleIT = Sheet1.Cells(i, "C") & " " & Sheet1.Cells(i, "B")
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).ApplyDataLabels
ActiveChart.SeriesCollection(1).XValues = "=Chartdata!$D$1:$G$1"
ActiveChart.SeriesCollection(2).DataLabels.Select
Selection.Delete


With ActiveChart
.HasTitle = True
.ChartTitle.Text = TitleIT
End With
'******


'
'Change the size of the markers
'
ActiveChart.SeriesCollection(1).Select
With Selection
.MarkerStyle = 2
.MarkerSize = 11
End With


'**** Get rid of lines in line chart
ActiveChart.SeriesCollection(1).Select
Selection.Format.Line.Visible = msoFalse
ActiveChart.SeriesCollection(2).Select
Selection.Format.Line.Visible = msoFalse
' Change ****** marker


'***** COLOR PLOT AREA ****


With ActiveChart.PlotArea.Format.Fill
.Visible = msoTrue
.TwoColorGradient msoGradientHorizontal, 1
.ForeColor.RGB = RGB(0, 166, 53)
.BackColor.RGB = RGB(255, 0, 0)
.GradientStops(1).Position = 0.47
.GradientStops.Item(1).Transparency = 0.8
.GradientStops(2).Position = 0.74
.GradientStops.Item(2).Transparency = 0.8
End With


'****************
'*** Change the color of the markers
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.Transparency = 0
End With
'''
'***************OUTPUT CHART HERE ?


'ActiveChart.ChartType = xlColumnClustered


ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=(Range("B" & i))  '***should be the value of Col B row i (variable)


Sheets("Chartdata").Activate
'
Next


Application.ScreenUpdating = True
End Sub

Regards.
 
Upvote 0
THANKS SO VERY MUCH FOR YOUR HELP! Still some issues, would you mind sharing a bit more of your expertise?

I did have it working, but since I changed the worksheet arrangement, I'm getting an error on the line which creates the charts.
1004 method
location of chart failed.

ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=(Range("B" & i)) '***should be the value of Col B row i (variable)

I tried to put error handling in the pgm, but that didn't work. Not sure why. What I think I should set up is the ability to handle errors and to delete a worksheet if I'm rerunning the program and the tab with that name already exists.


I can't thank you enough.

Best,
Bonnie

Sub MacroCHARTitV2()
'
' Macro1 Macro
'

'*********************need to move to next student
Dim i As Integer


' Allow access to file & eliminate flashing of screens
Application.ScreenUpdating = False
Sheets("Chartdata").Visible = True


'
Sheets("Chartdata").Select


With Sheets("Chartdata")
lFinalRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rngColA = .Range(.Cells(1, "A"), .Cells(lFinalRow, "A"))
End With
i = 2


'** For Each cell In rngColA.Cells
For i = 2 To lFinalRow


Rows(i).Select
MsgBox (i)
Range("D" & i & ":G" & i).Select 'Changed
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=Range("Chartdata!D" & i & ":G" & i) 'Changed
ActiveChart.SeriesCollection(1).Name = "=""Your Scores"""
ActiveChart.Legend.Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "=""CLASS"""
ActiveChart.SeriesCollection(2).Values = ("=Chartdata!H2:K2") 'Changed back this is the same for all charts
' If checktrue = True Then
'Chart Title


Dim TitleIT As String
ActiveChart.SetElement (msoElementChartTitleAboveChart)


TitleIT = Sheet1.Cells(i, "C") & " " & Sheet1.Cells(i, "B")
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).ApplyDataLabels
ActiveChart.SeriesCollection(1).XValues = "=Chartdata!$D$1:$G$1"
ActiveChart.SeriesCollection(2).DataLabels.Select
Selection.Delete


With ActiveChart
.HasTitle = True
.ChartTitle.Text = TitleIT
End With
'******


'
'Change the size of the markers
'
ActiveChart.SeriesCollection(1).Select
With Selection
'******************************************Marker color
'.MarkerBackgroundColorIndex = xlAutomatic
'.MarkerForegroundColorIndex = 7
'*************************************
.MarkerStyle = 2
.MarkerSize = 11
End With
''*************************



'**** Get rid of lines in line chart
ActiveChart.SeriesCollection(1).Select
Selection.Format.Line.Visible = msoFalse
ActiveChart.SeriesCollection(2).Select
Selection.Format.Line.Visible = msoFalse
' Change ****** marker


'***** COLOR PLOT AREA ****


With ActiveChart.PlotArea.Format.Fill
.Visible = msoTrue
.TwoColorGradient msoGradientHorizontal, 1
.ForeColor.RGB = RGB(0, 166, 53)
.BackColor.RGB = RGB(255, 0, 0)
.GradientStops(1).Position = 0.47
.GradientStops.Item(1).Transparency = 0.8
.GradientStops(2).Position = 0.74
.GradientStops.Item(2).Transparency = 0.8
End With

'************* Change the axis values

ActiveChart.Axes(xlValue).Select
ActiveChart.Axes(xlValue).MinimumScale = -1.5
ActiveChart.Axes(xlValue).MinimumScale = -4
ActiveChart.Axes(xlValue).MaximumScale = 2
ActiveChart.Axes(xlValue).MaximumScale = 4
ActiveChart.Axes(xlValue).MajorUnit = 0.5
ActiveChart.Axes(xlValue).MinorUnit = 0.1
ActiveChart.Axes(xlValue).MinorUnit = 0.5
'****************
'*** Change the color of the markers
'With Selection.Format.Fill
'.Visible = msoTrue
'.ForeColor.ObjectThemeColor = msoThemeColorText1
'.ForeColor.TintAndShade = 0 '
'.Transparency = 0
'End With
'''
'***************OUTPUT CHART HERE ?



ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=(Range("B" & i)) '***should be the value of Col B row i (variable)

MyErrorHandler:
If Err.Number = 1004 Then
MsgBox "Value not found"
GoTo Endit
End If
Sheets("Chartdata").Activate

Endit:
'
Next


Application.ScreenUpdating = True
End Sub
 
Upvote 0
This deletes all charts in active workbook:

Code: 
Sub delete_charts()
Dim ch As Chart


Application.DisplayAlerts = False
    For Each ch In ActiveWorkbook.Charts
        ch.Delete
    Next ch


Application.DisplayAlerts = True


End Sub

You can run it at the beginning of your macro by calling it:

Code: 
Call delete_charts

hope this helps.
 
Upvote 0
RMS123 said:
This deletes all charts in active workbook:

Code: 
Sub delete_charts()
Dim ch As Chart


Application.DisplayAlerts = False
    For Each ch In ActiveWorkbook.Charts
        ch.Delete
    Next ch


Application.DisplayAlerts = True


End Sub

You can run it at the beginning of your macro by calling it:

Code: 
Call delete_charts

hope this helps.
Click to expand...

Hi RMS123,

Won't this delete all the worksheets, including my input data?

My real problem is the error code I mentioned

I did have it working, but since I changed the worksheet arrangement, I'm getting an error on the line which creates the charts.
1004 method
location of chart failed.

ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=(Range("B" & i)) '***should be the value of Col B row i (variable)

I tried to put error handling in the pgm, but that didn't work. Not sure why. What I think I should set up is the ability to handle errors and to delete a worksheet if I'm rerunning the program and the tab with that name already exists. What in the code is causing the error?

Thanks for your help and patience.

Bonnie
 
Upvote 0
Charts and worksheets are different objects.

Here you go I think this is what you are looking for :)

Code: 
Sub MacroCHARTIT()


'*********************need to move to next student
Dim i As Integer
Dim ch As Chart
Dim answer As VbMsgBoxResult


' Allow access to file & eliminate flashing of screens
'Application.ScreenUpdating = False
'Call delete_charts
Sheets("Chartdata").Visible = True


'
Sheets("Chartdata").Select


With Sheets("Chartdata")
lFinalRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rngColA = .Range(.Cells(1, "A"), .Cells(lFinalRow, "A"))
End With
i = 2


'** For Each cell In rngColA.Cells
For i = 2 To lFinalRow
Application.DisplayAlerts = False
    For Each ch In ActiveWorkbook.Charts
        If ch.Name = Range("B" & i).Value Then
            answer = MsgBox("Delete chart" & ch.Name & " ?", vbYesNo)
                If answer = vbYes Then
                    ch.Delete
                End If
        End If
    Next ch


Application.DisplayAlerts = True
Rows(i).Select
MsgBox (i)
Range("D" & i & ":G" & i).Select 'Changed
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=Range("Chartdata!D" & i & ":G" & i) 'Changed
ActiveChart.SeriesCollection(1).Name = "=""Your Scores"""
ActiveChart.Legend.Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "=""CLASS"""
ActiveChart.SeriesCollection(2).Values = ("=Chartdata!H" & i & ":K" & i) 'Changed
' If checktrue = True Then
'Chart Title


Dim TitleIT As String
ActiveChart.SetElement (msoElementChartTitleAboveChart)


TitleIT = ActiveSheet.Cells(i, "C") & " " & ActiveSheet.Cells(i, "B")
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).ApplyDataLabels
ActiveChart.SeriesCollection(1).XValues = "=Chartdata!$D$1:$G$1"
ActiveChart.SeriesCollection(2).DataLabels.Select
Selection.Delete


With ActiveChart
.HasTitle = True
.ChartTitle.Text = TitleIT
End With
'******


'
'Change the size of the markers
'
ActiveChart.SeriesCollection(1).Select
With Selection
.MarkerStyle = 2
.MarkerSize = 11
End With


'**** Get rid of lines in line chart
ActiveChart.SeriesCollection(1).Select
Selection.Format.Line.Visible = msoFalse
ActiveChart.SeriesCollection(2).Select
Selection.Format.Line.Visible = msoFalse
' Change ****** marker


'***** COLOR PLOT AREA ****


With ActiveChart.PlotArea.Format.Fill
.Visible = msoTrue
.TwoColorGradient msoGradientHorizontal, 1
.ForeColor.RGB = RGB(0, 166, 53)
.BackColor.RGB = RGB(255, 0, 0)
.GradientStops(1).Position = 0.47
.GradientStops.Item(1).Transparency = 0.8
.GradientStops(2).Position = 0.74
.GradientStops.Item(2).Transparency = 0.8
End With


'****************
'*** Change the color of the markers
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.Transparency = 0
End With
'''
'***************OUTPUT CHART HERE ?


'ActiveChart.ChartType = xlColumnClustered
On Error Resume Next
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=(Range("B" & i).Value)  '***should be the value of Col B row i (variable)
If Err.Number = 1004 Then
MsgBox "Value not found"
GoTo Endit
End If
Sheets("Chartdata").Activate
'
Endit:


Next


Application.ScreenUpdating = True


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

Similar threads

A
  • Question
VBA problem with setting data source range
Replies
1
Views
858
Akbarov
A
A
  • Question
GANNT Chart
Replies
1
Views
814
antrawson
A
L
  • Question
VBA - Multiple Sheets - Create Pivot Charts on each sheet
Replies
0
Views
363
LNG2013
L
A
  • Question
Help with existing code in Post - VBA to Create Org Chart
Replies
1
Views
2K
mrpotato562
M
C
  • Solved
Create Function that Calculates a Value Relative to Original Price and Also Constructs a Price Ladder
2
Replies
10
Views
887
NdNoviceHlp
NdNoviceHlp

Forum statistics

Threads
1,215,169
Messages
6,123,412
Members
449,098
Latest member
ArturS75

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