Creating Charts using VBA

[chriscorpion786]

Hi All,

I have a macro that creates multiple charts from one sheet and places them on another sheet and realigns all in a grid manner.
The problem is that if I run the code from within the VB editor, the code runs perfectly, but if I run the code from the sheet using a button, it doesn't work. There are around 20 plus charts.
Is there a problem ??? I cant seem to understand that it runs fine from within the VB editor, then it should run fine as well from the sheet too....am i missing something here...
Appreciate your help...I'm running the code from sheet 2 using a button....sheet2 is Activesheet below

Below is the code

Sub CreateMultipleCharts()

Dim ChtObj As ChartObject
Dim ChtRng As Range
Dim x As Long
Dim lastrow As Long


Const rowstall As Long = 8
Const colswide As Long = 5
Const chtsperrow As Long = 4
Const skiprows As Long = 2
Const skipcols As Long = 1

Dim chtwidth As Double
Dim chtheight As Double
Dim chtleft As Double
Dim chttop As Double

Dim rowsbetweenchts As Double
Dim colsbetweenchts As Double


lastrow = Cells(Rows.Count, 2).End(xlUp).Row

On Error Resume Next
ActiveSheet.ChartObjects.Delete
Sheet3.ChartObjects.Delete

For x = 2 To lastrow

Set ChtRng = Union(Range("B1:N1"), Range("B" & x & ":N" & x))

ActiveSheet.ChartObjects.Add(20, 20, 300, 300).Select
With ActiveChart
.SetSourceData ChtRng
.ChartType = xlLineMarkers
.FullSeriesCollection(1).ApplyDataLabels
.FullSeriesCollection(1).DataLabels.Position = xlLabelPositionAbove
.FullSeriesCollection(1).DataLabels.NumberFormat = "#,###,"
.Axes(xlValue).MajorGridlines.Delete
.Axes(xlValue).Delete
.Legend.Delete
.ChartTitle.Format.TextFrame2.TextRange.Font.Size = 8
End With

Next x
Call MoveAllCharts


With ActiveSheet.Range("A2")
chttop = .Top
chtleft = .Left
chtwidth = colswide * .Width
chtheight = rowstall * .Height
rowsbetweenchts = skiprows * .Height
colsbetweenchts = skipcols * .Width
End With

'Reset X to Zero
x = 0


For x = 1 To ActiveSheet.ChartObjects.Count

Set ChtObj = ActiveSheet.ChartObjects(x)

With ChtObj
.Left = ((x - 1) Mod chtsperrow) * (chtwidth + colsbetweenchts) + chtleft
.Top = Int((x - 1) / chtsperrow) * (chtheight + rowsbetweenchts) + chttop
.Width = chtwidth
.Height = chtheight
End With

Next x
Range("A2").Select

End Sub

 

[rlv01]

Replace this:

On Error Resume Next
ActiveSheet.ChartObjects.Delete
Sheet3.ChartObjects.Delete

with this:

On Error Resume Next
ActiveSheet.ChartObjects.Delete
Sheet3.ChartObjects.Delete
On Error GoTo 0  '<- new line to turn error handling back on

Then run your macro from the button again to hopefully display an error message to give you a clue to what the problem is.

 

[chriscorpion786]

I tried it and it gave me the error : " The specified dimension is not valid for the current chart type"
The code stops at the macro named " MoveAllCharts " as stated above in the code
Here is the code for that macro:
Sub MoveAllCharts()

Dim ChtObj As ChartObject


For Each ChtObj In Sheet2.ChartObjects

ChtObj.Chart.Location xlLocationAsObject, "Dashboard" ' This is where it throws up the error


Next ChtObj


End Sub

 

[rlv01]

You are looping through all charts and it's telling you a property you are trying to set is invalid for some chart types. You could try this.

Sub MoveAllCharts()

Dim ChtObj As ChartObject

On Error Resume Next
For Each ChtObj In Sheet2.ChartObjects
   ChtObj.Chart.Location xlLocationAsObject, "Dashboard" ' This is where it throws up the error
Next ChtObj
On Error Goto 0
End Sub

No guarantees though.

Btw, your code is difficult to read. Please try to use Code Tags, as I have done in this post, when posting code here on the Forum.

 

[chriscorpion786]

Noted on the code tags,
I modified the code using the error handler as advised, but the charts stay in the sheet, so I used the delete method at the end of the code as well. Now, the code works fine from the button as well. Many thanks.

I hope I've used the code tags correctly.

Sub MoveAllCharts()

Dim ChtObj As ChartObject


For Each ChtObj In Sheet2.ChartObjects
On Error Resume Next
ChtObj.Chart.Location xlLocationAsObject, "Dashboard"

Next ChtObj
Sheet2.ChartObjects.Delete

End Sub