How to create Line charts? - excel

Question

I would like to create Line charts (2-D Line with Markers) for a set of records.
Screenshot of Excel tab
(a) Every three rows represent a set to be charted. The fourth column, though it appears, need not be charted. In the screenshot there are 18 rows, which is six sets of records.
(b) One Line chart required for each set of records. Hence a total of six charts to be created automatically.
(c) Also, the charts are to be created in different Excel tabs. Three charts per tab, hence this should create two Excel tabs with three charts placed in each tab.

Answer 1

I have prepared some code for automatic charts generation using VBA macro in excel see if this helps.
Below code will generate charts for data available in excel:
Dim Startrow As String
Dim Lastrow As String
Dim Lastcolumn As String
Dim ws1 As String
Dim cs2 As String
Dim cs3 As String
Dim ws(100)
Dim count As String
Dim i As Integer
Sub Final()
For j = 2 To Sheets.count
count = Sheets.count
Sheet1.Activate
Cells(i, 1) = Sheets(i).Name
'ws(i) = Sheets(i).Name
'MsgBox Sheets.Count
'MsgBox count
'MsgBox ws(i)
Next
For i = 2 To count
MsgBox count
MsgBox i
Sheet1.Activate
ws(i) = Cells(i, 1)
Sheets(ws(i)).Activate
'Sheets(ws(i)).Activate
MsgBox ws(i)
'MsgBox Range("B1")
'MsgBox IsEmpty(Range("B2"))
If IsEmpty(Range("B1")) = False Then
Startrow = 2
'MsgBox Startrow
Lastrow = Cells(Rows.count, 1).End(xlUp).Row
'MsgBox Lastrow
Lastcolumn = Split(Columns(Range("A1").End(xlToRight).Column).Address(, False), ":")(1)
'MsgBox Lastcolumn
Call test1
MsgBox i
End If
Next
End Sub
Function test1()
Dim letter As String
Dim letter1 As String
Dim letter2 As String
Dim letter3 As String
Dim x As Integer
MsgBox ws(i)
x = Range(Lastcolumn & 1).Column
'MsgBox x
Dim cs As Worksheet
Set cs = ThisWorkbook.Sheets.Add
'ws.name = "PrivateBytes_000005_Charts"
'ws2 = "PrivateBytes_000005_Charts"
cs.Name = ws(i) + "_Charts"
'MsgBox ws.Name
cs2 = ws(i) + "_Charts"
MsgBox cs2
cs3 = ws(i)
MsgBox cs3
If x < 27 Then
For i = 2 To x
letter3 = Chr(64 + i)
'chart command
Sheets(cs2).Activate
ActiveSheet.Shapes.AddChart2(227, xlLineStacked).Select
ActiveChart.SetSourceData Source:=Sheets(cs3).Range("A" & Startrow & ":A" & Lastrow & "," & letter3 & Startrow & ":" & letter3 & Lastrow)
With ActiveChart
.HasTitle = True
Sheets(cs3).Activate
.ChartTitle.Text = Range(letter3 & "1").Value
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
Next
End If
If x >= 27 Then
For i = 2 To 26
letter3 = Chr(64 + i)
'chart command
Sheets(cs2).Activate
ActiveSheet.Shapes.AddChart2(227, xlLineStacked).Select
ActiveChart.SetSourceData Source:=Sheets(cs3).Range("A" & Startrow & ":A" & Lastrow & "," & letter3 & Startrow & ":" & letter3 & Lastrow)
With ActiveChart
.HasTitle = True
Sheets(cs3).Activate
.ChartTitle.Text = Range(letter3 & "1").Value
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
Next
For i = 27 To x
letter3 = Chr(Int((i - 1) / 26) + 64) & Chr(((i - 1) Mod 26) + 65)
'MsgBox letter3
'chart command
Sheets(cs2).Activate
ActiveSheet.Shapes.AddChart2(227, xlLineStacked).Select
ActiveChart.SetSourceData Source:=Sheets(cs3).Range("A" & Startrow & ":A" & Lastrow & "," & letter3 & Startrow & ":" & letter3 & Lastrow)
With ActiveChart
.HasTitle = True
Sheets(cs3).Activate
.ChartTitle.Text = Range(letter3 & "1").Value
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
Next
End If
Sheets(cs.Name).Activate
ActiveChart.Parent.Name = "Test1"
Call AutoSpace_Shapes_Vertical
'Return
'Unload UserForm1
End Function
Function AutoSpace_Shapes_Vertical()
'Automatically space and align shapes
Sheets(cs2).Activate
ActiveSheet.ChartObjects("Test1").Activate
ActiveSheet.Shapes.SelectAll
Dim shp As Shape
Dim lCnt As Long
Dim dTop As Double
Dim dLeft As Double
Dim dHeight As Double
Const dSPACE As Double = 8
'Check if shapes are selected
If TypeName(Selection) = "Range" Then
MsgBox "Please select shapes before running the macro."
Exit Function
End If
'Set variables
lCnt = 1
'Loop through selected shapes (charts, slicers, timelines, etc.)
For Each shp In Selection.ShapeRange
With shp
'If not first shape then move it below previous shape and align left.
If lCnt > 1 Then
.Top = dTop + dHeight + dSPACE
.Left = dLeft
End If
'Store properties of shape for use in moving next shape in the collection.
dTop = .Top
dLeft = .Left
dHeight = .Height
End With
'Add to shape counter
lCnt = lCnt + 1
Next shp
End Function
'End Sub
'End Sub
enter image description here