Excel VB - creating chart using combo box

[possom]

Hi all,

I am a newbie to VB, but have used Excel quite a bit. I have created a Gantt chart manually using start and duration data, but that took a while, so I borrowed some VB code (from http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q213447) to automate it a little... but now I will have to copy the required cells to another sheet, create the chart using the macro for each group of data. I would like to have a sheet dedicated to producing a chart initiated from a selection in the combo box.

I know exactly what I want, but don't know where to start... the process would be:
1. Sheet A would be prepopulated similar to the following data:

-------------------------------------------------------------
      |    Date: 20/12/2004      |    Date: 21/12/2004      |...
-------------------------------------------------------------
Name  | Start |  End  | Duration | Start |  End  | Duration |...
-------------------------------------------------------------
proc1 | 02:30 | 02:45 | 00:15    | 02:10 | 02:45 | 00:35    |...
proc2 | 03:10 | 03:45 | 00:35    | 03:10 | 03:45 | 00:35    |...
proc3 | 04:00 | 04:50 | 00:50    | 04:10 | 04:20 | 00:10    |...
...

2. Sheet B would have a combo box that would contain the date cell text(e.g. 'Date: 20/12/2004', 'Date: 21/12/2004').
3. The user would select the date required from the combo box, the macro would then determine the two series ranges for the date (Start and Duration) and create a chart (based on the macro code below) which would be placed inside Sheet B.
Note: the X-axis would have to always use the static 'Name' column data.

I hope I haven't confused you. Any help would be appreciated.

Cheers,
Phil

Macro Code:

Option Explicit

Sub Gantt_Chart()
    'Define the variables.
    Dim rge As String
    Dim ValueAxisMinValue As Date
    Dim shtname As String
    Dim Title As String, aChart As Chart
    'Store the location of the data as a string.
    rge = Selection.Address()
    'Store the start date for the chart.
    ValueAxisMinValue = Selection.Cells(2, 2).Value
    'Ask user for the Chart title.
    Title = InputBox("Please enter the title")
    'Store the sheet name.
    shtname = ActiveSheet.Name
    'Turn off screen updating.
    Application.ScreenUpdating = False
    'Create a chart located on a chart sheet.
    Set aChart = Charts.Add
    With aChart
        .ChartWizard Source:=Sheets(shtname).Range(rge), _
        Gallery:=xlBar, Format:=3, PlotBy:=xlColumns, _
        CategoryLabels:=1, SeriesLabels:=1, HasLegend:=1, _
        Title:=Title, CategoryTitle:="process", ValueTitle:="time", _
        ExtraTitle:=""
        'Remove the legend.
        .Legend.Delete
        'Create and format the series.
        With .SeriesCollection(1)
            With .Border
                .Weight = xlThin
                .LineStyle = xlNone
            End With
            .InvertIfNegative = False
            .Interior.ColorIndex = xlNone
        End With
        With .SeriesCollection(2)
            With .Border
                .Weight = xlThin
            End With
            .InvertIfNegative = False
            .Interior.ColorIndex = 5
        End With
        'Modify the category (x) axis.
        With .Axes(xlCategory)
            .ReversePlotOrder = True
            .TickLabelSpacing = 1
            .TickMarkSpacing = 1
            .AxisBetweenCategories = True
        End With
        'Modify the value (y) axis.
        With .Axes(xlValue)
            .MinimumScale = ValueAxisMinValue
            .MaximumScaleIsAuto = True
            .MinorUnitIsAuto = True
            .MajorUnitIsAuto = True
            .Crosses = xlAutomatic
            .ReversePlotOrder = False
            .ScaleType = False
            .HasMajorGridlines = True
            .HasMinorGridlines = False
        End With
     End With
    'Turn screen updating back on.
    Application.ScreenUpdating = True

 End Sub

 

[possom]

Please help - I can create the chart fine when selecting some cells, but I would like to automate this using a combo box (populated from a row of data - see above), and once a selection is made, calculate the appropriate columns for the chart Data Source.

TIA,
possom

 

[possom]

Hey,

I am real close to a result... I have the chart creating with a combo box, but I am having one issue with the source data. Since there is a 'Start', 'End' and 'Duration' column for each data series, I want to only use the 'Start' and 'Duration' for the gantt chart values, and the 'End' column is in the middle, so I just can't leave it out of the range.

To get this working when creating a chart manually I hide the 'End' column and selected the remaining two columns. How can I automate this within a macro?

I have tried doing this before the chart macro:

Sheets("Master").Columns(...).EntireColumn.Hidden = True

but it gives me an error at the 'SeriesCollection(2)' line saying: "Run-time error 1004, Method 'SeriesCollection' of object '_Chart' failed".

Any help would be good.

Thanks,
possom

 

[possom]

Hi all,

I figured out my last problem, which I solved by copying the graph source data to the active sheet, then creating the graph from that instead.

Incase anyone else wants to do something similar, heres the steps:

1. Create a 'master' sheet to contain all graphable data (Start, End and Duration times for all categories).
2. Create a new sheet where the Gantt Chart will be created from.
3. Add a Combo Box from the Control Toolbox into the new chart sheet.
4. Right click on the new chart sheet tab at the bottom and select View Code.
5. Add the following to the sheet's code:

Option Explicit
Private Const kListHnd As String = "ListValues"
Private comboChangeEventEnabled As Boolean
Private Const chooseCombo As String = "Choose Business Date"
Private Const averageCombo As String = "Average"
Private Sub Worksheet_Activate()
    processCombo.Activate
    comboChangeEventEnabled = False
    loadComboValues
    populateCombo
    comboChangeEventEnabled = True
End Sub
'---------------------------------------------------------------------
Public Sub loadComboValues()
'---------------------------------------------------------------------
'Dim oWsData As Worksheet
Dim cRows As Long, cCols As Long, i As Long, j As Long

    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    On Error GoTo load_exit

    cCols = Sheets("SAP Master").Cells(2, Columns.Count).End(xlToLeft).Column
    ' Add 2 to compensate for the merged cells
    cCols = cCols + 2
    ThisWorkbook.Names.Add Name:=kListHnd, _
                           RefersToR1C1:="='SAP Master'!R2C8:R2C" & cCols

load_exit:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub
Public Function populateCombo()
    Dim i As Long

    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    On Error GoTo popCombo_exit
    
    With processCombo
        .Clear
        .AddItem chooseCombo
        For i = 8 To Sheets("SAP Master").Range(kListHnd).Count + 7
            If (Sheets("SAP Master").Cells(2, i).Value <> "") Then
                .AddItem Sheets("SAP Master").Cells(2, i).Value
            End If
        Next i

        'Application.EnableEvents = True
        .ListIndex = 0
    End With

popCombo_exit:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Function
Private Sub processCombo_Change()
    Dim oFoundCell As Range, oTargetRng As Range
    Dim sourceData As String, businessDate As String
    Dim cRange As Range, pRange As Range, dRange As Range
    Dim sourcesheet As Worksheet
    
    Set sourcesheet = Sheets("SAP Master")
    
    businessDate = processCombo.Value
    
    If Not comboChangeEventEnabled Then Exit Sub
    If businessDate = chooseCombo Then Exit Sub

    'Delete all existing charts in this sheet first
    ActiveSheet.ChartObjects.Delete
    'Delete any existing data source
    Set dRange = ActiveSheet.Range("A9:C" & sourcesheet.Range("C65536").End(xlUp).Row)
    dRange.Clear
    
    With sourcesheet.Range("ListValues")
        ' Check if it is the 'Average' or Date entry
        If businessDate = averageCombo Then
            Set oFoundCell = .Find(businessDate)
        Else
            Set oFoundCell = .Find(DateValue(businessDate))
        End If

        If oFoundCell Is Nothing Then
            MsgBox "Critical error " & businessDate & " not found", vbCritical, "(xld) Dynamic DropDowns"
            Exit Sub
        End If
        Set oTargetRng = oFoundCell.Offset(1, 0)
        
        'Copy category process names
        Set cRange = sourcesheet.Range("G3:G" & sourcesheet.Range("F65536").End(xlUp).Row)
        Set pRange = ActiveSheet.Range("A9")
        cRange.Copy
        pRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
          
        'Copy source Start data
        sourceData = oTargetRng.Address & ":" & oTargetRng.Offset(34, 0).Address
        Set cRange = sourcesheet.Range(sourceData)
        Set pRange = ActiveSheet.Range("B9")
        cRange.Copy
        pRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
        'Copy source Duration data
        sourceData = oTargetRng.Offset(0, 2).Address & ":" & oTargetRng.Offset(34, 2).Address
        Set cRange = sourcesheet.Range(sourceData)
        Set pRange = ActiveSheet.Range("C9")
        cRange.Copy
        pRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
        'Set number format on date/time columns
        Set pRange = ActiveSheet.Columns("B:C")
        pRange.NumberFormat = "h:mm:ss"
        
        'Exit the copy/paste mode
        Application.CutCopyMode = False
        
        ActiveSheet.Range("A9:C" & ActiveSheet.Range("C65536").End(xlUp).Row).Select
        
        'Create Gantt Chart
        Gantt_Chart businessDate
            
    End With

End Sub
Sub Gantt_Chart(businessDate As String)

    'Define the variables.
    Dim rge As String
    Dim ValueAxisMinValue As Date
    Dim shtname As String, sourcename As String
    Dim Title As String, aChart As Chart
    
    'Store the sheet name.
    shtname = ActiveSheet.Name
    
    'Store the location of the data as a string.
    rge = Selection.Address()
    
    'Store the start date for the chart.
    ValueAxisMinValue = ActiveSheet.Range(rge).Cells(2, 2).Value
    'Ask user for the Chart title.
    Title = "SAP Process Times for " & businessDate
    
    On Error GoTo gChart_exit
    
    'Turn off screen updating.
    Application.ScreenUpdating = False
    'Create a chart located on a chart sheet.
    Set aChart = Charts.Add
    Set aChart = aChart.Location(Where:=xlLocationAsObject, Name:=shtname)
    With aChart
        .ChartWizard Source:=ActiveSheet.Range(rge), _
        Gallery:=xlBar, Format:=3, PlotBy:=xlColumns, _
        CategoryLabels:=1, SeriesLabels:=1, HasLegend:=1, _
        Title:=Title, CategoryTitle:="", ValueTitle:="", _
        ExtraTitle:=""
        'Remove the legend.
        .Legend.Delete
        .PlotArea.Interior.ColorIndex = xlNone
        'Create and format the series.
        With .SeriesCollection(1)
            With .Border
                .Weight = xlThin
                .LineStyle = xlNone
            End With
            .InvertIfNegative = False
            .Interior.ColorIndex = xlNone
        End With
        With .SeriesCollection(2)
            With .Border
                .Weight = xlThin
            End With
            .InvertIfNegative = False
            .Interior.ColorIndex = 5
        End With
        'Modify the category (x) axis.
        With .Axes(xlCategory)
            .ReversePlotOrder = True
            .TickLabelSpacing = 1
            .TickMarkSpacing = 1
            .AxisBetweenCategories = True
            .TickLabels.AutoScaleFont = False
            .TickLabels.Font.Size = 8
        End With
        'Modify the value (y) axis.
        With .Axes(xlValue)
            .MinimumScale = ValueAxisMinValue
            .MaximumScaleIsAuto = True
            .MinorUnitIsAuto = True
            .MajorUnitIsAuto = True
            .Crosses = xlAutomatic
            .ReversePlotOrder = False
            .ScaleType = False
            .HasMajorGridlines = True
            .HasMinorGridlines = False
            .TickLabels.AutoScaleFont = False
            .TickLabels.Font.Size = 8
        End With
        
        ' Resize the chart
        With .Parent
            .Top = ActiveSheet.Range("E3").Top
            .Left = ActiveSheet.Range("E3").Left
            .Height = ActiveSheet.Range("E3:Q45").Height
            .Width = ActiveSheet.Range("E3:Q45").Width
        End With

     End With

gChart_exit:
    'Turn screen updating back on.
    Application.ScreenUpdating = True

End Sub

Obviously you will need to customise it a little such as number of categories/rows of data, handling of average data, sheet names, type/format of data being graphed etc. but there you go, Gantt Chart operated by a Combo box!

Cheers,
possom