I have a table in excel with multiple columns and rows. I have written this simple code to generate a Line chart from my table:
Sub DrawLine()
Dim cht As ChartObject
For Each cht In Worksheets(Sheets.Count).ChartObjects
cht.Chart.Type = xlLine
Next cht
End Sub
However, when I execute this code I can't see my chart, unless if I have another chart on my worksheet generated manually. In this case, when I execute the code, the chart changes to display what my sub is doing.
Does anyone know what could be the problem ?
You're not creating any charts with your code. What you're doing is changing any chart currently there to become a line chart.
There are many things missing in your code. Pl see example below.
Sub Test()
Dim LastRow As Long
Dim Rng1 As Range
Dim ShName As String
With ActiveSheet
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set Rng1 = .Range("A2:A" & LastRow & ", B2:B" & LastRow)
ShName = .Name
End With
Charts.Add
With ActiveChart
.ChartType = xlLine
.SetSourceData Source:=Rng1
.Location Where:=xlLocationAsObject, Name:=ShName
End With
End Sub
Related
I need to create Bar chart in Excel VBA. I used the code below, but when I am ADDING or DELETING A ROW it is not working.
I need that chart on fixed range (K1). Because when I am calculating for the second time it creates another chart.
How can I change the code to prevent a new chart being added when I adjust the data source?
Private Sub CommandButton2_Click()
Sheets("Sheet7").Range("F2:H12").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlBarClustered
ActiveChart.SetSourceData Source:=Range("Sheet7!$F$2:$H$12")
ActiveChart.SeriesCollection(1).Name = "=Sheet7!$G$1"
ActiveChart.SeriesCollection(2).Name = "=Sheet7!$H$1"
End Sub
In the sample code below it checks to see if a chart called TheChart already exists, and if not, creates a new one. You can now add and remove rows and the chart should will update. Additionally, if you add a new row at the bottom and click the button it will redraw TheChart without creating a new one.
The chart is always located at the top-left of K1 per the rngChartTopLeft variable - which you can adjust if required.
The code assumes that it is running in a Sheet module (hence Set ws = Me) and if you were running it in a standard module you can set the sheet with Set ws = ThisWorkbook.Worksheets("your_sheet").
Option Explicit
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim chto As ChartObject
Dim rngChartTopLeft As Range
Dim rngData As Range
' assumes the code is in a sheet object
Set ws = Me
' top left of chart
Set rngChartTopLeft = ws.Range("K1")
' create chart or get existing chart
If ws.ChartObjects.Count = 0 Then
Set chto = ws.ChartObjects.Add( _
Left:=rngChartTopLeft.Left, _
Width:=500, _
Top:=rngChartTopLeft.Top, _
Height:=500)
chto.Name = "TheChart"
Else
Set chto = ws.ChartObjects("TheChart")
End If
' set chart type
chto.Chart.ChartType = xlBarClustered
' get data range per last row of data
Set rngData = ws.Range("F2:G" & ws.Cells(ws.Rows.Count, "G").End(xlUp).Row)
' set new chart range
chto.Chart.SetSourceData rngData
End Sub
please check the below code:
Option Explicit
Private Sub CommandButton1_Click()
Dim mychart As Shape
Dim lastrow As Long
lastrow = Sheet7.Cells(Rows.Count, "F").End(xlUp).Row
For Each mychart In ActiveSheet.Shapes
If mychart.Name = "CommandButton1" Then GoTo exit_
mychart.Delete
exit_:
Next
Sheets("Sheet7").Range("F2:H" & lastrow).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlBarClustered
ActiveChart.SetSourceData Source:=Range("Sheet7!$F$2:$H$" & lastrow)
ActiveChart.SeriesCollection(1).Name = "=Sheet7!$G$1"
ActiveChart.SeriesCollection(2).Name = "=Sheet7!$H$1"
End Sub
I am getting:
Run-time error '-2147467259 (80004005)':
Method 'SetSourceData' of object '_Chart' failed
intermittently when I try to run the following script:
Sub CreatePiePivot()
'Define worksheets
Set PSheet = Sheets("Tools")
Set DSheet = Sheets("Aggregate")
'Define last data points
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
'Selects first to last filled row, and first to last filled column for data
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
'Create pivot cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange)
'Moves user to Dashboard
Sheets("Tools").Activate
'Create blank pivot table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Range("F1"), _
TableName:="ExcPT1")
'Create blank pivot chart
PSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlPie
ActiveChart.SetSourceData _
Source:=Range("$F$2:$H$19"), _
PlotBy:=xlRows
ActiveWorkbook.ShowPivotTableFieldList = False
With ActiveChart.PivotLayout.PivotTable.PivotFields("Exception")
.Orientation = xlRowField
.Position = 1
End With
'Insert Data
With PSheet.PivotTables("ExcPT1").PivotFields("Exception")
.Orientation = xlDataField
.Position = 1
.Caption = "Exception Status Count"
.Function = xlCount
End With
'Hide Not Due
With ActiveChart.PivotLayout.PivotTable.PivotFields("Exception Status")
.PivotItems("Not due").Visible = False
End With
'Move bar chart to Dashboard; resize
ActiveChart.ChartArea.Select
ActiveChart.Location Where:=xlLocationAsObject, Name:="Dashboard"
Set ChartWidth = Sheets("Dashboard").Range("B26:L49")
With ActiveChart.Parent
.Height = ChartWidth.Height
.Width = ChartWidth.Width
.Top = ChartWidth.Top
.Left = ChartWidth.Left
End With
With ActiveChart
.HasTitle = False
End With
End Sub
This sub is running after another very similar sub that creates a pivot bar chart using a sub connected to a button:
Sub CreatePivots()
Call CreateBarPivot
Call CreatePiePivot
End Sub
The BarPivot runs perfectly, no problem, every time, and looks almost identical to the PiePivot shown above with the applicable changes to display the appropriate data. If I run those subs separately, it usually runs without a problem. I ran-and-deleted the sub and results three times before I got the error. The debug is pointing at this line:
ActiveChart.SetSourceData _
Source:=Range("$F$2:$H$19"), _
PlotBy:=xlRows
...but it looks exactly like the one used by the BarPivot. Since it's not happening exactly every time, but most of the time, I'm not sure where to start on troubleshooting. The documentation I've looked up (which is sparse by the way, or I'm looking in the wrong places) indicates I'm doing this right.
What's causing the error, and how do I fix it?
This is an example to illustrate how to avoid using Select and Activate in your code, plus a few other (hopefully useful) comments.
Always Use Option Explicit - this can't be emphasized enough
This will turn the first few lines of your Sub into:
Option Explicit
Sub CreatePiePivot()
Dim thisWB As Workbook
Set thisWB = ThisWorkbook
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Set PSheet = thisWB.Sheets("Tools")
Set DSheet = thisWB.Sheets("Aggregate")
Notice that by defining thisWB, you're setting up a workbook reference in a single line that, if you ever needed to change workbooks, change that one line and you're done. Also, this reference can explain why you should use ThisWorkbook over ActiveWorkbook.
Because some of your issues involve assumed references (either workbooks or worksheets or charts), the next lines can help show some necessary references that are easy to miss:
'Define last data points
Dim lastRow As Long
Dim lastCol As Long
lastRow = DSheet.Cells(DSheet.Rows.Count, 1).End(xlUp).Row
lastCol = DSheet.Cells(1, DSheet.Columns.Count).End(xlToLeft).Column
Notice here that you have to reference DSheet inside of the Cells reference to guarantee that you're referring to the same worksheet. Otherwise VBA could assume that you're referring to the ActiveSheet, which may be completely different and give you an incorrect value.
The next few lines become:
'Selects first to last filled row, and first to last filled column for data
Dim PRange As Range
Set PRange = DSheet.Cells(1, 1).Resize(lastRow, lastCol)
'Create pivot cache
Dim PCache As PivotCache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange)
Your next statement in your code is Sheets("Tools").Activate which, unless there is a specific reason you want to display that worksheet to the user at this time, is completely unnecessary. If you want the user to view this worksheet when all processing is completed, move this statement to the end of the Sub.
Next:
'Create blank pivot table
Dim PTable As PivotTable
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Range("F1"), _
TableName:="ExcPT1")
The real fix for your error comes next:
'Create blank pivot chart
Dim PChart As Chart
Set PChart = PSheet.Shapes.AddChart
PChart.ChartType = xlPie
PChart.SetSourceData Source:=PSheet.Range("$F$2:$H$19"), PlotBy:=xlRows
Because you're creating an object for the newly added chart, you never have to use ActiveChart. It follows the same idea of specifying complete references.
And so on... you can hopefully use these examples to finish out the rest of your code and work through some of the issues you're having. Give it a try.
I'm trying to generate two charts using VBA. The problem is most examples use ActiveChart but I want multiple charts on multiple sheets. If I inserted a blank chart how do I rename that chart to reference it. I don't want a new chart to be generated each time I run the macro and I want it to be in the sheet. I'm struggling with the code but am assuming it will be something like the code below. I've attached the desired graph (I made this through excel, but I need to do it through VBA).
macro1()
lastrow2 = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
dim chart1 as chart
dim chart2 as chart ' ect
chart1.title = "test"
chart1.xaxis = sheet1.cell(lastrow2,1)
chart1.yaxis = "manhours"
end sub
using a the record function, i got the code commented below. I tried to change it but i'm still having issues
Sub Macro7()
Dim Chart2 As ChartObject
Dim chartb As Chart
Chart2 = Sheet1.chartb.SeriesCollection(2)
chartb.Select
Formula = "=SERIES(Master!R3C3,Master!R4C1:R18C1,Master!R4C3:R19C3,2)"
' ActiveChart.SeriesCollection(2).Select
' Selection.Formula =_
'"=SERIES(Master!R3C3,Master!R4C1:R18C1,Master!R4C3:R19C3,2)"
End Sub
I really just need this formula converted to i can reference my lastrow function and individual sheets
ActiveChart.SeriesCollection(2).Select
Selection.Formula =_
"SERIES(sheet1.cells(3,3),sheet1.cells(4,1):sheet1.cells(18,1)_
,sheet1.cells(4,3):sheet1.cells(4,19),2"
' Selection.Formula"_
' =SERIES(Master!R3C3,Master!R4C1:R18C1,Master!R4C3:R19C3,2)"
this was what i was trying to do. It declares the sheet name and references an existing chart named chart 1.
Dim cht As ChartObject
Dim rng As Range
Set cht = Sheets("Master").ChartObjects("Chart 1")
Set rng = Sheets("Master").Range("A4", Range("D4").End(xlDown).Offset(-1))
cht.Chart.SetSourceData Source:=rng
cht.Chart.HasTitle = True
cht.Chart.ChartTitle.Text = "Bird Report - By Cost Code/Activity" ' title
cht.Chart.SeriesCollection(1).Name = "=Master!$B$3"
cht.Chart.SeriesCollection(2).Name = "=Master!$C$3"
cht.Chart.SeriesCollection(3).Name = "=Master!$D$3"
I have the following VBA code that works to export a range of cells into a jpeg into a specified folder. I would like to have it loop through all worksheets in one workbook.
I need help looping this code through all open workbooks. I believe I will need to:
Dim WS As Worksheet, then set up an If statement, insert the below code, end the if statement, then at the end put a Next WS for it to actually loop through. My problem is, is that I keep getting a 91 error when I try to combine my if statement, For Each WS In ThisWorkbook.Sheets If Not WS.Name = "Sheet2" Then, with my code below.
The following code works in one worksheet at a time.
Sub ExportAsImage()
Dim objPic As Shape
Dim objChart As Chart
Dim i As Integer
Dim intCount As Integer
'copy the range as an image
Call ActiveSheet.Range("A1:F2").CopyPicture(xlScreen, xlPicture)
'remove all previous shapes in the ActiveSheet
intCount = ActiveSheet.Shapes.Count
For i = 1 To intCount
ActiveSheet.Shapes.Item(1).Delete
Next i
'create an empty chart in the ActiveSheet
ActiveSheet.Shapes.AddChart
'select the shape in the ActiveSheet
ActiveSheet.Shapes.Item(1).Select
ActiveSheet.Shapes.Item(1).Width = Range("A1:F2").Width
ActiveSheet.Shapes.Item(1).Height = Range("A1:F2").Height
Set objChart = ActiveChart
'clear the chart
objChart.ChartArea.ClearContents
'paste the range into the chart
objChart.Paste
'save the chart as a JPEG
objChart.Export ("C:\Users\------\Desktop\Test\" & Range("B2").Value & ".jpg")
'remove all shapes in the ActiveSheet
intCount = ActiveSheet.Shapes.Count
For i = 1 To intCount
ActiveSheet.Shapes.Item(1).Delete
Next i
End Sub
Add this to your module:
Sub MAIN()
Dim sh As Worksheet
For Each sh In Sheets
sh.Activate
Call ExportAsImage
Next sh
End Sub
and run it. (there is no need to modify your code)
I have a question regarding VBA.
I am trying to apply the below code to all the sheets in a workbook.
The workbook contains numerous worksheets but have all the datapoints in the same cells
The only difference are the sheet's names.
So Basically "MoneyMarket" is just a name of one sheet of the workbook.
Tried using for each sheet but got kind of stuck of how to apply this
Dim YRange As Integer, ProjectionRange As Integer
Dim XRange As Range
Dim I As Integer
Sub DrawChart()
Set XRange = Sheets("MoneyMarket"). _
Range("R8:R" & Sheets("MoneyMarket").Range("R8").End(xlDown).Row)
ProjectionRange = Sheets("MoneyMarket").Range("T54").End(xlDown).Row
YRange = Sheets("MoneyMarket").Range("S8").End(xlDown).Row
Sheets("MoneyMarket").Range("S8:S" & YRange).Select
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:="MoneyMarket"
ActiveChart.SeriesCollection.Add Source:=Sheets("MoneyMarket").Range("T8:X" & YRange)
ActiveChart.ChartType = xlLine
ActiveChart.Axes(xlCategory).Select
ActiveChart.SeriesCollection(1).XValues = XRange
For I = 2 To 6
ActiveChart.SeriesCollection(I).Select
With Selection.Format.Line
.DashStyle = msoLineDash
End With
Next I
End Sub
a very quick search in Google will give you the answer on how to loop through all sheets in a workbook. This is just an example
Dim WS_Count As Integer
Dim I As Integer
' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For I = 1 To WS_Count
' Insert/Modify your code here. It will be applied to each sheet.
'For example to get their names
msgbox ActiveWorkbook.Worksheets(I).Name
Next I
If you are interested on a loop across some sheets in a workbook, I recommend you use an array like that:
Sub loopAcrossSheets()
temp = Array("Sheet1", "Sheet3", "SheetX")
For Each SheetName In temp
DrawChart (SheetName)
Next
End Sub
Then you should put the input string on your Sub:
Sub DrawChart(SheetName As String)
And, at last, replace the sheet name ("MoneyMarket") by SheetName!
This Works for me!
You have to create a Module, and refer directly to ActiveSheet in your code, check the code below
Dim YRange As Integer, ProjectionRange As Integer
Dim XRange As Range
Dim I As Integer
Public Sub DrawChart()
Dim ActiveSheetName as String
ActiveSheetName = ActiveSheet.Name
Set XRange = ActiveSheet. _
Range("R8:R" & ActiveSheet.Range("R8").End(xlDown).Row)
ProjectionRange = ActiveSheet.Range("T54").End(xlDown).Row
YRange = ActiveSheet.Range("S8").End(xlDown).Row
Sheets("MoneyMarket").Range("S8:S" & YRange).Select
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:=ActiveSheetName
ActiveChart.SeriesCollection.Add Source:=ActiveSheet.Range("T8:X" & YRange)
ActiveChart.ChartType = xlLine
ActiveChart.Axes(xlCategory).Select
ActiveChart.SeriesCollection(1).XValues = XRange
For I = 2 To 6
ActiveChart.SeriesCollection(I).Select
With Selection.Format.Line
.DashStyle = msoLineDash
End With
Next I
End Sub