- A Chart is a Graphical Representation of Data
- If we are able to depict the chart almost 70% analysation has been completed
- Whilst it is time consuming process, if we require to depict the chart for more number of Data items
- Through VBA Program we can create N Number of charts with sime click...
- Hope this is page is useful to everyone
Charting Ratio
Creation of Charts for all the Ratios
Sub Charts_to_Ratios()
Dim i As Integer
i = 2
Do Until Sheets("Ratios").Range("B" & i).Value = ""
Range("B" & i).Activate
Max = Sheets("Ratios").Range(ActiveCell, ActiveCell.End(xlToRight)).Columns.Select
Selection.Copy
Dim sh As Worksheet
Set sh = Worksheets.Add(after:=Sheets("ratios"))
sh.Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Sheets("Ratios").Range("E1:I1").Copy
sh.Range("E1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Dim ch As ChartObject
With sh.Range("C4:I17")
Set ch = sh.ChartObjects.Add( _
Left:=.Left, _
Height:=.Height, _
Width:=.Width, _
Top:=.Top)
End With
With ch.Chart
If Sheets("Ratios").Range("B" & i).Offset(0, 2).Value = "Percentage" Then
.ChartType = xlLine
Else
.ChartType = xlColumnClustered
End If
.SeriesCollection.NewSeries
.SeriesCollection(1).Name = q
.SeriesCollection(1).Values = sh.Range("E2:I2")
.SeriesCollection(1).XValues = sh.Range("E1:I1")
.SeriesCollection(1).ApplyDataLabels
.Legend.Position = xlLegendPositionTop
.SeriesCollection(1).Interior.Color = RGB(255, 0, 0)
End With
sh.Range("B20:D20").Select
With Selection
.Merge
.Value = "Reporting\Comments:"
End With
sh.Name = Sheets("Ratios").Range("B" & i)
ActiveWindow.DisplayGridlines = False
Sheets("Ratios").Activate
i = i + 1
Loop
End Sub
Creation of Charts for Selected Ratio
Sub Charts_to_Ratios()
q = ActiveCell.Value
Max = Sheets("Ratios").Range(ActiveCell, ActiveCell.End(xlToRight)).Columns.Select
Selection.Copy
Dim sh As Worksheet
Set sh = Worksheets.Add(after:=Sheets("ratios"))
sh.Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Sheets("Ratios").Range("E1:I1").Copy
sh.Range("E1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Dim ch As ChartObject
With sh.Range("C4:I17")
Set ch = sh.ChartObjects.Add( _
Left:=.Left, _
Height:=.Height, _
Width:=.Width, _
Top:=.Top)
End With
With ch.Chart
.ChartType = xlColumnClustered
.SeriesCollection.NewSeries
.SeriesCollection(1).Name = q
.SeriesCollection(1).Values = sh.Range("E2:I2")
.SeriesCollection(1).XValues = sh.Range("E1:I1")
.SeriesCollection(1).ApplyDataLabels
.Legend.Position = xlLegendPositionTop
.SeriesCollection(1).Interior.Color = RGB(255, 0, 0)
End With
sh.Range("B20:D20").Select
With Selection
.Merge
.Value = "Reporting\Comments:"
End With
sh.Name = q
End Sub