Add and remove rows for bar chart created by VBA - vba

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

Related

Loop through excel tables and create graphs

I have multiple tables in one worksheet and I need to loop through tables(list objects) and generate corresponding line graphs. I tried using for each loop and it is not working:
How can I use 'for each' loop to generate graphs? How to reference each list object as a range to my graphs?
Sub chart_create()
Dim tbl As listobject
'Loop through each sheet and table in the workbook
For Each tbl In ActiveSheet.ListObjects
Call graph
End Sub
Next tbl
End Sub
'macro to generate charts
Sub graph()
Dim rng As Range
Dim cht As ChartObject
'how do i change this to reference corresponding list object
Set rng = Selection
Set cht = ActiveSheet.ChartObjects.Add( _
Left:=ActiveCell.Left, _
Width:=450, _
Top:=ActiveCell.Top, _
Height:=250)
'Give chart some data
cht.Chart.SetSourceData Source:=rng
'Determine the chart type
cht.Chart.ChartType = xlLine
End Sub
Pass the Range for the ListObject into your second subroutine as a parameter:
Sub chart_create()
Dim tbl As listobject
'Loop through each sheet and table in the workbook
For Each tbl In ActiveSheet.ListObjects
Call graph tbl.Range
Next tbl
End Sub
'macro to generate charts
Sub graph(rng as range)
Dim cht As ChartObject
Set cht = ActiveSheet.ChartObjects.Add( _
Left:=ActiveCell.Left, _
Width:=450, _
Top:=ActiveCell.Top, _
Height:=250)
'Give chart some data
cht.Chart.SetSourceData Source:=rng
'Determine the chart type
cht.Chart.ChartType = xlLine
End Sub
First, it looks like you have an extra End Sub in there. Next tbl must come before End Sub or else it will never be reached.
Second, you need to pass a reference to your table into the graphing function.
Sub chart_create()
Dim tbl As listobject
'Loop through each sheet and table in the workbook
For Each tbl In ActiveSheet.ListObjects
Call graph(tbl)
Next tbl
End Sub
And then...
Sub graph(tbl As ListObject)
'Make your graph here, referencing the tbl you passed in
End Sub
Edit: Lastly, just to be clear, your comment says that you're "looping through each sheet and table in the workbook," but you're actually just looping through listobjects on the active worksheet. If you want to loop through each worksheet, you'll need to have an extra loop outside the existing loop like:
For Each ws In Worksheets
'For Each tbl In ws.ListObjects....
Next ws

Using charts with VBA

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"

Loop through worksheets while exporting range as image

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)

Chart not generated from vba code unless another chart already exists

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

Applying same VBA code on all sheets in a workbook

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