Passing arguments to a graphing function

[RawlinsCross]

Good day. I have a userform with approximately 50 labels each containing a number which is the latest number in a column of numbers (i.e. I have 50 columns and say 365 rows). I have a code that calls another userform which has a graph when you click on any of the 50 labels (see code below).

So the long of it is - I don't want to make 50 separate userforms for each of the labels. I'd like to have just one userform containing the code (see below again) that accepts arguments for things like axis title, MinimumScale, NumberFormat, .Range - things like that. How is this done?

Private Sub UserForm_Initialize()

Dim MyChart As Chart
Dim ChartData As Range
Dim ChartName As String
Application.ScreenUpdating = False
Worksheets("Dashboard").Range("H4").Value = ActiveWindow.Zoom
ActiveWindow.Zoom = 85
 
Set ChartData = Worksheets("Main Element Profiles").Range("Y7:Y37")
        

ActiveSheet.Range("B2").Select
Set MyChart = ActiveSheet.Shapes.AddChart(xlXYScatterLines).Chart

With MyChart
    .SeriesCollection.NewSeries
    .SeriesCollection(1).Name = ChartName
    .SeriesCollection(1).Values = ChartData
    .SeriesCollection(1).XValues = Worksheets("Main Element Profiles").Range("B7:B37")
    .Legend.Select
        Selection.Delete
    .Axes(xlCategory).Select
        Selection.TickLabels.NumberFormat = "m/d/yyyy"
        Selection.TickLabels.NumberFormat = "[$-409]mmm-dd;@"
    .Axes(xlValue).Select
        Selection.TickLabels.NumberFormat = "#,##0.00"
        Selection.TickLabels.NumberFormat = "#,##0.0,"
    .Axes(xlValue).HasTitle = True
    .Axes(xlValue).MinimumScale = 0
    .Axes(xlValue).AxisTitle.Text = "Na Concentration (g/L)"
End With
   

Dim ImageName As String
ImageName = Application.DefaultFilePath & Application.PathSeparator & "TempChart.jpeg"
MyChart.Export filename:=ImageName
ActiveSheet.ChartObjects(1).Delete
ActiveWindow.Zoom = Worksheets("Dashboard").Range("H4").Value
Application.ScreenUpdating = True
ASSAY221FLASH2NA.Image1.Picture = LoadPicture(ImageName)
 
End Sub

 

[Jerry Sullivan]

It may help to review the code in the A1_EBAL1 userform that creates the chart when A1_EBAL1 is first activated.

The module level variables in blue font are used to hold the parameters that are needed to make the chart.
Each of those variables has a Let or Set statement in green font, that allows the variable to be set from another module.

Userform RoadMap creates an instance of A1_EBAL1, and before that is shown RoadMap passes values to these 5 variables.
Those preliminary steps provide A1_EBAL1 with all the information needed to create the initial chart through a call to Sub MakeChart.

Study how that works in the code below, because once you have a good understanding of that, it will be much easier to add code to redraw the chart based on the datepicker selections in A1_EBAL1.

Option Explicit

'--userform module variables
[COLOR="#0000CD"]Private msAxisTitle As String
Private msCaptionForGraph As String
Private msDataIdentifier As String
Private mrXValues As Range
Private mrYValues As Range
[/COLOR]

'--public properties
[COLOR="#008000"]Public Property Let AxisTitle(sAxisTitle As String)
   msAxisTitle = sAxisTitle
End Property

Public Property Let DataIdentifier(sDataIdentifier As String)
   msDataIdentifier = sDataIdentifier
End Property

Public Property Let CaptionForGraph(sCaptionForGraph As String)
   msCaptionForGraph = sCaptionForGraph
End Property

Public Property Set XValues(rXValues As Range)
   Set mrXValues = rXValues
End Property

Public Property Set YValues(rYValues As Range)
   Set mrYValues = rYValues
End Property
[/COLOR]

'--userform events
Private Sub UserForm_Activate()
 Call MakeChart
End Sub

'--private procedures
Private Sub MakeChart()
 '--creates a new chart, makes a jpg image and displays the image
 Dim MyChart As Chart
 Dim dblZoomSave As Double
 Dim ChartName As String
 Dim ImageName As String
 Dim wksTemp As Worksheet

 Application.ScreenUpdating = False
 
 '--store current zoom
 dblZoomSave = ActiveWindow.Zoom
 ActiveWindow.Zoom = 85
 
 Set wksTemp = ThisWorkbook.Worksheets.Add
 
 wksTemp.Range("A1").Select
 Set MyChart = ActiveSheet.Shapes.AddChart(xlXYScatterLines).Chart

 With MyChart
   .SeriesCollection.NewSeries
   .SeriesCollection(1).Name = msCaptionForGraph
   .SeriesCollection(1).Values = mrYValues
   .SeriesCollection(1).XValues = mrXValues

   .Legend.Delete
   
   With .Axes(xlCategory)
      .TickLabels.NumberFormat = "m/d/yyyy"
   End With
   
   With .Axes(xlValue)
      .TickLabels.NumberFormat = "#,##0"
      .HasTitle = True
      .MinimumScale = 0
      .AxisTitle.Text = msAxisTitle
   End With

 End With

 ImageName = Application.DefaultFilePath & Application.PathSeparator & "TempChart.jpeg"
 MyChart.Export filename:=ImageName
 
 Application.DisplayAlerts = False
 wksTemp.Delete
 Application.DisplayAlerts = True
 
 '--reset zoom
 ActiveWindow.Zoom = dblZoomSave
 Application.ScreenUpdating = True
 
 Me.Image1.Picture = LoadPicture(ImageName)
 Me.Caption = msCaptionForGraph
End Sub

Using the technique of breaking big problems into smaller parts, try this sequence.

1. Make a Sub RedrawAsIs in A1_EBAL1. It will look very similar to Sub MakeChart. The only difference is that you'll add "Redrawn: " as the prefix to the userform Caption that was initially read from msCaptionForGraph. Add a temporary button to A1_EBAL1. The objective is that when you click that button, the Chart will be recreated using all the same values that are already stored in the 5 module level variables. The only visible change besides a flicker, will be the addition of "Redrawn: " to the caption.

Once that is working, you could progress through these steps.
2. Modify RedrawAsIs to use X and Y axis data the way you retrieved it in Redraw_Click.

3. Modify RedrawAsIs to retrieve X and Y axis data by calling a the same sub that RoadMap usied to get this data from the worksheet. Rename your Sub Redraw_Click and delete your existing code with the same name.

Optional Bonus Step!
4. MakeChart and Redraw_Click will have a lot of redundancy. Try making a single sub does the chart drawing that both MakeChart and Redraw_Click can call with different parameters.

 

[RawlinsCross]

Very awesome - these member variables are very convenient with Set/Let:

Private Sub Redraw_Click()
Call MakeChart
End Sub

'--private procedures
Private Sub MakeChart()

 '--creates a new chart, makes a jpg image and displays the image
 Dim MyChart As Chart
 Dim dblZoomSave As Double
 Dim ImageName As String
 Dim lColNdx As Long

'Checks for alternate dates chosen by user on the graph userform
If Me.DTPicker3.Value <> RoadMap.DTPicker1.Value _
Or Me.DTPicker4.Value <> RoadMap.DTPicker2.Value Then

Set mrXValues = rGetXValuesRange(wks:=Worksheets("EBal"), _
   dtStart:=Me.DTPicker3.Value, dtEnd:=Me.DTPicker4.Value)

 lColNdx = lGetHeaderColNumber(wks:=Worksheets("EBal"), _
   sDataIdentifier:=msDataIdentifier)

 Set mrYValues = mrXValues.Offset(0, lColNdx - 1)

End If

 Application.ScreenUpdating = False
 
 '--store current zoom
 dblZoomSave = ActiveWindow.Zoom
 ActiveWindow.Zoom = 85
 
 
 ActiveSheet.Range("B2").Select
 Set MyChart = ActiveSheet.Shapes.AddChart(xlXYScatter).Chart
 With MyChart
   .SeriesCollection.NewSeries
   .SeriesCollection(1).Values = mrYValues
   .SeriesCollection(1).XValues = mrXValues
   .Legend.Delete
   
   With .Axes(xlCategory)
       .TickLabels.NumberFormat = "[$-409]mmm-dd;@"
   End With
   
   With .Axes(xlValue)
      .TickLabels.NumberFormat = "#,##0"
      .HasTitle = True
      .MinimumScale = 0
      .AxisTitle.Text = msAxisTitle
   End With
 End With
 ImageName = Application.DefaultFilePath & Application.PathSeparator & "TempChart.jpeg"
 MyChart.Export filename:=ImageName
 
 Application.DisplayAlerts = False
 ActiveSheet.ChartObjects(1).Delete
 Application.DisplayAlerts = True
 
 '--reset zoom
 ActiveWindow.Zoom = dblZoomSave
 Application.ScreenUpdating = True
 
 Me.Image1.Picture = LoadPicture(ImageName)
 Me.Caption = msCaptionForGraph
 
End Sub

 

[RawlinsCross]

Hi Jerry, figured I'd update you on the wishlist I outlined in post #89 .

1. Bring functionality to the A1_EBAL1 graph. I'd like to pass back DTPicker3 and DTPicker4 to re-graph in case the user wishes to zoom in or zoom out in time. Also y-axis scale adjustment.
This is now done except for the y-axis scale adjustment but that's just a matter of adding an additional property.


2. 50 more labels, over each graphic, invisible first. Group into another class?? Add a command button to main RoadMap userform so when the user clicks it each label appears over its graphic presenting a percentage (to what percentage do all the inputs balance the outputs for the element selected). Click again to make labels disappear.

So, as you have seen in the spreadsheet I sent you there are 'nodes' in which there are elemental flows in and out. So the question remains - for each of the elements, what is the balance around each 'node' (i.e do the inputs balance the outputs). So I added 50 more labels, gave them appropriate name, placed them over the graphic representing the node, and tagged them with the string "Mass Balance", then went into the spreadsheet and manually labeled each column as an input or an output to the node (e.g. AC_IN_Ni or AC_OUT_Ni). Then I followed your step-by-step method. *note I added a checkbox on the RoadMap userform to either show or hide the balance for the nodes as you click on the element buttons*

ElementButtonClass *added MassBalance method*

Option Explicit
 
Public WithEvents ElementButtonGroup As CommandButton
 
Private mfrmParent As RoadMap

'--public properties
Public Property Set Parent(frmParent As RoadMap)
 Set mfrmParent = frmParent
End Property
'--event procedures
Private Sub ElementButtonGroup_Click()
 '--store selection in roadmap property
 ElementButtonGroup.Parent.SelectedElement = ElementButtonGroup.Name
 
 '--resets all Element Buttons to default colors, selection to green
 ElementButtonGroup.Parent.ResetElementButtons
 ElementButtonGroup.BackColor = vbGreen
 ElementButtonGroup.Parent.SumByElement
 ElementButtonGroup.Parent.MassBalance
End Sub

RoadMap *MassBalance Method calls another GetTotalSumFromWorksheet*

Public Sub MassBalance()

'A check box on the userform if left unchecked exists hides all the
'mass balance labels (if shown already) and exits sub.
'If it is checked, it performs the mass balance.
Dim Ctrl As Control
If Me.CheckBox1.Value = False Then
    For Each Ctrl In Me.Controls
    If TypeName(Ctrl) = "Label" Then
        If Ctrl.Tag = "MassBalance" Then
            Ctrl.Visible = False
        End If
    End If
Next Ctrl
Exit Sub
Else
Dim MassBalArray() As Variant
Dim lMassBalCount As Long
Dim vElement As Variant
Dim sBalanceIn As String
Dim sBalanceOut As String
Dim rngMassBalance As Range
Dim lTotalMassIn As Double
Dim lTotalMassOut As Double
Dim lFinalBalancePCT As Double
Dim dtStartDate As Date
Dim dtEndDate As Date

dtStartDate = Me.DTPicker1.Value
dtEndDate = Me.DTPicker2.Value
'Step 1 - Make array of controls with the tag "Mass Balance"
For Each Ctrl In Me.Controls
    If TypeName(Ctrl) = "Label" Then
        If Ctrl.Tag = "MassBalance" Then
            lMassBalCount = lMassBalCount + 1
            ReDim Preserve MassBalArray(1 To lMassBalCount)
            MassBalArray(lMassBalCount) = Ctrl.Name
        End If
    End If
Next Ctrl
'Step 2 - For each control
For Each vElement In MassBalArray
'Step 3 - Form Mass Balance Identifier for INs depending on the element selected(e.g.  POL_IN_Ni)
    sBalanceIn = vElement & "_IN_" & msSelectedElement
    
'Step 4 - Make the IN sum depending on the date range chosen
    lTotalMassIn = GetTotalSumFromWorksheet(sLookUpTag:=sBalanceIn, dtStartDate:=dtStartDate, dtEndDate:=dtEndDate)
    
'Step 5 - Form Mass Balance Identifier for OUTs depending on the element selected(e.g.  POL_OUT_Ni)
    sBalanceOut = vElement & "_OUT_" & msSelectedElement
    
'Step 6 - Make the OUT sum depending on the date range chosen
    lTotalMassOut = GetTotalSumFromWorksheet(sLookUpTag:=sBalanceOut, dtStartDate:=dtStartDate, dtEndDate:=dtEndDate)
    
'Step 7 - Calculate Mass Balance as Sum of INs / Sum of Outs
    lFinalBalancePCT = lTotalMassIn / (lTotalMassOut + 0.00000000001) * 100
'Step 8 - Enter value from Step 7 in the caption of the control
    Me.Controls(vElement).Caption = Format(lFinalBalancePCT, "0.0") & "% "
'Step 9 - Make control visible and format
    Me.Controls(vElement).Visible = True
    Me.Controls(vElement).WordWrap = False
    Me.Controls(vElement).AutoSize = True
Next vElement
End If
End Sub

GetTotalSumFromWorksheet *scans for all INs/OUTs for a given tag (e.g. AC_IN_Ni) and sums them up.

Function GetTotalSumFromWorksheet(sLookUpTag As String, dtStartDate As Date, dtEndDate As Date) As Double
'--this function returns the summation for all INs and OUTs for a given node
Dim lColumnNbr As Long
Dim lStartDate As Long
Dim lEndDate As Long
Dim lSum As Double
Dim rHeaders As Range
Dim rData As Range
Dim wks As Worksheet
Dim rFirstAddress As String
Dim lTotalSum As Double
Dim c As Range
Set wks = Worksheets("EBal")
Set rHeaders = wks.Range("rngHeaders")
Set rData = wks.Range("A:A")

On Error Resume Next
'returns the row number of the StartDate
lStartDate = rData.Find(What:=dtStartDate, Lookat:=xlWhole, LookIn:=xlValues, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False).Row
'returns the row number of the EndDate
lEndDate = rData.Find(What:=dtEndDate, Lookat:=xlWhole, LookIn:=xlValues, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False).Row

'returns the correct column number/letter referenced from the 'A' column
Set c = rHeaders.Find(What:=sLookUpTag, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
lColumnNbr = c.Column
If Not c Is Nothing Then
    rFirstAddress = c.Address
    Debug.Print rFirstAddress
    Do
        'sum the associated range
        lSum = Application.Sum(Range(wks.Cells(lEndDate, lColumnNbr), wks.Cells(lStartDate, lColumnNbr)))
        lTotalSum = lTotalSum + lSum
        Set c = rHeaders.FindNext(c)
        lColumnNbr = c.Column
    Loop While c.Address <> rFirstAddress
End If
On Error GoTo 0
'returns the column sum to the calling procedure.  If the first character of the string is a number returns NA
GetTotalSumFromWorksheet = lTotalSum
End Function

 

[RawlinsCross]

Hi Jerry,

There was an outstanding question first posed in post #81 which involved defaulting the RoadMap userform to element "Ni". Couldn't figure it out and went on to other things (see above). You mentioned that ElementButtonGroup won't have any context (meaning) in RoadMap, and that I'd need to reference the button control directly. Just thought about it some more and figured it out - little sheepish it was so simple.

'--event procedures
Private Sub UserForm_Initialize()

 Call BlendColors
 
 Call InitializeControls
 
 Call PopulateControlArrays
 
 msSelectedElement = "Ni"
 Call SumByElement
 Me.Controls(msSelectedElement).BackColor = vbGreen

SumByElement Code

Public Sub SumByElement()
'--the purpose is to step through each point of the flow process, calculate summations at that point and display each sum in the Label control at that pont.
'--each summation will based on the currently selected element and date range selected by the user.
Dim sSelectedElement As String
Dim vChartButton As Variant
Dim sLookUpTag As String
Dim dtStartDate As Date
Dim dtEndDate As Date

sSelectedElement = msSelectedElement
dtStartDate = Format(Me.DTPicker1.Value, "mm/dd/yyyy")
dtEndDate = Format(Me.DTPicker2.Value, "mm/dd/yyyy")

For Each vChartButton In ChartButtons
        sLookUpTag = vChartButton.ChartButtonGroup.Name & "_" & sSelectedElement
        If Me.CheckBox2.Value = True Then
            vChartButton.ChartButtonGroup.Caption = Format(GetSumFromWorksheet(sLookUpTag:=sLookUpTag, dtStartDate:=dtStartDate, dtEndDate:=dtEndDate) / ((dtEndDate - dtStartDate) * 24), "0.000")
        Else
            vChartButton.ChartButtonGroup.Caption = GetSumFromWorksheet(sLookUpTag:=sLookUpTag, dtStartDate:=dtStartDate, dtEndDate:=dtEndDate)
        End If
        vChartButton.ChartButtonGroup.WordWrap = False
        vChartButton.ChartButtonGroup.AutoSize = True
Next vChartButton


End Sub