VBA Dynamic Graph From SQL Data

[fba1]

I have been trying to figure this out for a while and have found my solution, and thought I should share. Basically I was trying to create a graph in excel without having to reference the data from any cell values, this would create from there a static graph in the end. So here is the code I'm sure it will get its fair share of use.

Sub CreateHBG()
Dim strSQL14, strSQL15, strSQL16 As String
Dim hbsdate, hbedate
Dim cnn10 As New ADODB.Connection
Dim rst10 As New ADODB.Recordset
Dim ctValues() As Variant
Dim ctAxis() As String
Dim chtChart As Chart
Dim MyNewSrs As Series
Dim e As Integer
 
'Requires
'MS ADO 2.8 Library
'MS ADO Ext. 2.8 for DDL and Security
'MS Graph 12.0 Object Library
 
'Select the sheet to run the import
Sheets("Run").Select
 
'HEAT connection string
cnn10.CommandTimeout = 0
cnn10.ConnectionTimeout = 0
cnn10.Open _
"PROVIDER=SQLOLEDB;DATA SOURCE=Server;UID=Username;PWD=Password;DATABASE=Database"
 
'Select statement to find out when the first linked ticket was created (Also known as the start of the heatboard)
strSQL14 = "SELECT TOP 1 a.RecvdDate as 'FirstLinked', a.RecvdTime " & _
"FROM olsheat.heat_user.CallLog a " & _
"WHERE a.CallID IN " & _
"(SELECT b.CallID FROM " & _
"olsheat.heat_user.HEATSGen c INNER JOIN " & _
"olsheat.heat_user.HEATHot b ON c.SGName = b.HotName WHERE " & _
"(c.SGCode LIKE 'H%') AND " & _
"(b.CallID IS NOT NULL) AND " & _
"(c.SGName = '0000004202'))" & _
"Order By a.RecvdDate ASC"
 
rst10.Open strSQL14, cnn10, adOpenStatic
 
'Hold the date in a string for later reference
hbsdate = Format(rst10.Fields!FirstLinked, "mm/dd/yyyy")
hbsdate = CDate(hbsdate)
 
rst10.Close
 
'Select statement to find out when the last linked ticket was created
strSQL15 = "SELECT TOP 1 a.RecvdDate as 'LastLinked', a.RecvdTime " & _
"FROM olsheat.heat_user.CallLog a " & _
"WHERE a.CallID IN " & _
"(SELECT b.CallID FROM " & _
"olsheat.heat_user.HEATSGen c INNER JOIN " & _
"olsheat.heat_user.HEATHot b ON c.SGName = b.HotName WHERE " & _
"(c.SGCode LIKE 'H%') AND " & _
"(b.CallID IS NOT NULL) AND " & _
"(c.SGName = '0000004202'))" & _
"Order By a.RecvdDate DESC"
 
rst10.Open strSQL15, cnn10, adOpenStatic
 
'Hold the date in a string for later reference
hbedate = Format(rst10.Fields!LastLinked, "mm/dd/yyyy")
hbedate = CDate(hbedate)
 
rst10.Close
 
e = 0
 
'ReDim Preserve ctValues(e), ctAxis(e)
 
'Loop until the end date has been added to the array
Do Until hbsdate = hbedate + 1
 
strSQL16 = "SELECT a.RecvdDate, COUNT(a.CallID) 'Tickets' " & _
"FROM olsheat.heat_user.CallLog a " & _
"WHERE a.RecvdDate = '" & Format(hbsdate, "YYYY-MM-DD") & "' AND a.CallID IN " & _
"(SELECT b.CallID FROM " & _
"olsheat.heat_user.HEATSGen c INNER JOIN " & _
"olsheat.heat_user.HEATHot b ON c.SGName = b.HotName WHERE " & _
"(c.SGCode LIKE 'H%') AND " & _
"(b.CallID IS NOT NULL) AND " & _
"(c.SGName = '0000004202'))" & _
"Group By a.RecvdDate"
 
rst10.Open strSQL16, cnn10, adOpenStatic
 
'Set the array as blank
ReDim Preserve ctValues(e), ctAxis(e)
 
If rst10.EOF Then
ctAxis(e) = hbsdate
ctValues(e) = "0"
Else
hbsdate = rst10.Fields!RecvdDate
ctAxis(e) = Format(rst10.Fields!RecvdDate, "mm/dd/yyyy")
ctValues(e) = rst10.Fields!Tickets
End If
 
rst10.Close
 
hbsdate = DateAdd("d", 1, hbsdate)
 
'Hold the value into the dynamic array since static cannot be used to determine the size
ReDim Preserve ctValues(e), ctAxis(e)
 
e = e + 1
 
Loop
 
'If the array holds more than one value create a graph otherwise do not
If e > 1 Then
 
ActiveSheet.Shapes.AddChart.Select
 
Set MyNewSrs = ActiveChart.SeriesCollection.NewSeries
With MyNewSrs
        .Name = "Tickets"
        .Values = Array(ctValues)
        .XValues = Array(ctAxis)
    End With
    
'Charts require office 2007 due to style references
    ActiveChart.ChartTitle.Text = "HEATBoard #" & "4202"
    ActiveChart.ChartType = xlLine
    ActiveChart.ChartStyle = 40
    ActiveChart.Parent.RoundedCorners = True
    ActiveChart.SetElement (msoElementLegendBottom)
    ActiveChart.ChartArea.Border.Color = RGB(248, 161, 90)
    ActiveChart.ChartArea.Border.Weight = xlThick
    ActiveChart.Axes(xlCategory).TickLabelSpacing = 1
    ActiveChart.Axes(xlCategory, xlPrimary).TickLabels.Orientation = 45
    ActiveChart.Parent.Width = 500
    ActiveChart.Parent.Height = 275
    
End If
 
End Sub