Create Comment Chart via VBA

Option Explicit
Dim cmt As Comment, myrng As Range, rowcount As Long, mychart As Chart
Dim pathname As String, i As Long, datarng As Range, axisrng As Range, captionrange As Range

Private Sub Workbook_Open()


On Error Resume Next
Application.ScreenUpdating = False
    i = 2
    rowcount = ThisWorkbook.Sheets(1).Range("A2").End(xlDown).Row
    pathname = "C:\temp\"
    For i = 2 To rowcount
        Set myrng = ThisWorkbook.Sheets(1).Range("G" & i)
        myrng.Comment.Delete

            Set cmt = myrng.AddComment
            Set mychart = Charts.Add
            Set mychart = mychart.Location(xlLocationAsObject, "Sheet1")
            Set datarng = ThisWorkbook.Sheets(1).Range("B" & i & ":F" & i)
            Set axisrng = ThisWorkbook.Sheets(1).Range("B1:F1")
            Set captionrange = ThisWorkbook.Sheets(1).Range("A" & i)
            mychart.SetSourceData Source:=datarng
            mychart.SeriesCollection(1).XValues = axisrng
            mychart.SetElement msoElementChartTitleAboveChart
            mychart.ChartTitle.Caption = captionrange
            mychart.HasLegend = False
         
            mychart.Export pathname & "temp" & i & ".jpg", "jpg"
            With cmt.Shape
                    .Fill.UserPicture ("C:\temp\temp" & i & ".jpg")
                    .ScaleHeight 2, msoFalse
                    .ScaleWidth 3, msoFalse
            End With
        ThisWorkbook.Sheets(1).ChartObjects.Delete
    Next
    Set myrng = Nothing
    Set mychart = Nothing
    Set datarng = Nothing
    Set axisrng = Nothing
    Set captionrange = Nothing



End Sub

https://drive.google.com/file/d/0B23eJ2xd9ODyUGRDLV9IbWMxSkk/edit?usp=sharing

Generate Chart on Worksheet_Change Event

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$E$2" Then
        Select Case Target.Value
            Case "SOUTH"
                Call createGraph(Target.Value)
     
            Case "WEST"
                Call createGraph(Target.Value)
            Case "NORTH"
                Call createGraph(Target.Value)
            Case "MIDWEST"
                Call createGraph(Target.Value)
         
        End Select
    End If
End Sub


Dim myChart As Chart, rowcount As Long, datarng As Range, axisrng As Range
Public Sub createGraph(mycriteria As String)
'On Error Resume Next
Application.ScreenUpdating = False
    ThisWorkbook.Sheets("Dashboard").Range(ThisWorkbook.Sheets("Dashboard").Range("D6").CurrentRegion.Address).Clear
    ThisWorkbook.Sheets(2).Range("A1").AutoFilter Field:=1, Criteria1:=mycriteria
    ThisWorkbook.Sheets(2).UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=ThisWorkbook.Sheets(1).Range("D6")
    ThisWorkbook.Sheets(1).ChartObjects.Delete
    rowcount = ThisWorkbook.Sheets(1).Range("D6").End(xlDown).Row
    Set datarng = ThisWorkbook.Sheets(1).Range("J7:J" & rowcount)
    Set axisrng = ThisWorkbook.Sheets(1).Range("D7:D" & rowcount)

    Set myChart = Charts.Add
    Set myChart = myChart.Location(xlLocationAsObject, "Dashboard")
 
        With myChart
            .Parent.Top = ThisWorkbook.Sheets(1).Range("D6").Top
            .Parent.Left = ThisWorkbook.Sheets(1).Range("D10").Left
            .Parent.Width = ThisWorkbook.Sheets(1).Range("D10:J10").Width
            .Parent.Height = ThisWorkbook.Sheets(1).Range("D6:D20").Height
            .SetSourceData Source:=datarng
            .SeriesCollection(1).XValues = axisrng
            .HasTitle = True
            .ChartType = xlColumnClustered
            .SetElement (msoElementChartTitleAboveChart)
            .ChartTitle.Caption = "Sales amount for " & mycriteria
        End With
    End Sub


https://drive.google.com/file/d/0B23eJ2xd9ODyZ2V1LUdYNXVmMFE/edit?usp=sharing

Representing Dynamic Chart for Survey Data

Whenever you need to draw dynamic chart in a userform depending on parameters & factors of survey as mentioned above,VBA macro code is mentioned below.You will have to select one parameter at a time mentioned at the left hand side of the chart.The only requirement for this code is to set focus of your cursors on data points on an excel spreadsheet and to load an image control in form

Private Sub UserForm_initialize()
Call showGraph

End Sub


Sub showGraph()
Dim currentrow As Long
Dim currentchart As Chart
Dim pathname As String
Dim chartheader, datasource, chartdatasource As Range
   currentrow = ActiveCell.Row
    On Error GoTo Errorhandler

    If currentrow <= 1 Then
       MsgBox "Move cell pointer to a row that contains data of Row Labels"
    End If
   
    Set chartheader = ActiveSheet.Range("A1:F1")
    Set datasource = ActiveSheet.Range(Cells(currentrow, 1), Cells(currentrow, 6))
   
    Set chartdatasource = Union(chartheader, datasource)
   
    Range(chartdatasource.Address).Select
    ActiveSheet.Shapes.AddChart.Select
   
    ActiveChart.SetSourceData Source:=chartdatasource, PlotBy:=xlRows
    ActiveChart.ChartType = xlColumnClustered

        pathname = ThisWorkbook.Path & "\temp.gif"
        If Not Dir(pathname) = "" Then
               Kill pathname
            End If
    ActiveChart.Export Filename:=pathname, filtername:="gif"
   
   
    pathname = ThisWorkbook.Path & "\temp.gif"
    UserForm1.Image1.Picture = LoadPicture(pathname)
   
        ActiveSheet.ChartObjects.Delete
   
   
    Exit Sub
Errorhandler:
    MsgBox "Error description" & Err.Description
End Sub