Passing arguments to a graphing function

RawlinsCross

Active Member
Joined
Sep 9, 2016
Messages
437
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?

Code:
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
 
while I'm running the code the ?rHeaders.Address displays correctly. But my manual find on the sheet fails for ACFEED_AC_Ni but doesn't fail for ACFEED_AC_. I sent you some screenshots on your gmail.

Manually typing in the AC_FEED_Ni (you can see it's a formula concantention) doesn't change anything.

I have had some excel "Out of Memory" recently but it seems to have subsided. Wondering if it's related.
 
Last edited:
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Try testing a few other tags that you know exist in that range.

If it’s just on bad label in your worksheet, try replacing that value by typing it in the cell. You might have spaces or other non print characters.
 
Upvote 0
I testing several other tags in row 2... all returning column 0. Typed in the look_up_tags manually. Nothing. Now if I expand rngHeaders to include row 1 and change cell ("YS1") to ACFEED_AC_Ni instead of ACFEED_AC_ then I can run the code before and I get returning 669
 
Upvote 0
A few other suggestions:

1. When you test Find manually, if you have more than one cell selected, Excel will just search that range. Make sure to select just one cell (which will search the entire worksheet), or select the range of cells in rngHeaders.

2. When you test Find manually, make all the options the same as the code. I noticed in the screen shot you hadn't checked "Match entire contents" (although that wouldn't explain the results you got).

3. I had assumed rngHeaders was just the a single row range on Row 2. Is there any reason you are making that range span rows 2:7? Your lookuptags are all on Row 2. (once again, this wouldn't explain the symptoms, if using multiple rows, I'd add a SearchBy: parameter to the Range.Find call).

4. You mentioned recently having some out of memory errors. If you haven't already done so, I'd suggest you close your apps and restart you computer.
 
Upvote 0
Success!!! Okay, this code works

RoadMap:


Code:
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 dStartDate As Date
Dim dEndDate As Date

'Step 1:  Get the currently selected element
sSelectedElement = msSelectedElement

'Step 2:  For each label in the collection of labels follow steps 3 to 7
'Step 3:  Combine the tag property of the label and the element presently selected.  This is known as the look_up_tag
'Step 4:  Take the look_up_tag and search for that tag which will be above the data to be summated.
'Step 5:  Find the row range that corresponds to DTPicker1 and DTPicker2.
dStartDate = Me.DTPicker1.Value
dEndDate = Me.DTPicker2.Value

For Each vChartButton In ChartButtons
    sLookUpTag = vChartButton.ChartButtonGroup.Name & "_" & sSelectedElement
    vChartButton.ChartButtonGroup.Caption = GetSumFromWorksheet(sLookUpTag:=sLookUpTag, dStartDate:=dStartDate, dEndDate:=dEndDate)
    vChartButton.ChartButtonGroup.WordWrap = False
    vChartButton.ChartButtonGroup.AutoSize = True
Next vChartButton

'Step 6:  Sum up the range for the column from Step 4 and the rows from Step 5
'Step 7:  Output the sum in the caption of the label

End Sub

Function:
Code:
Function GetSumFromWorksheet(sLookUpTag As String, dStartDate As Date, dEndDate As Date) As String
'--this function returns the summation at this point in the process using the arguments to find the worksheet range
'--(for now) this function returns the column number of the tag which will be above the dta to be summed.

Dim lColumnNbr As Long
Dim lStartDate As Long
Dim lEndDate As Long
Dim sColumnNbr As String
Dim sFinalRange As String
Dim rHeaders As Range
Dim rData As Range
Dim wks As Worksheet
Set wks = Worksheets("EBal")
Set rHeaders = wks.Range("rngHeaders")
Set rData = wks.Range("A:A")

Application.FindFormat.Clear

On Error Resume Next

'returns the correct column number/letter referenced from the 'A' column
lColumnNbr = rHeaders.Find(What:=sLookUpTag, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False).Column
sColumnNbr = Split(Cells(1, lColumnNbr).Address, "$")(1)

On Error GoTo 0
Application.FindFormat.Clear

'returns the row number of the StartDate
lStartDate = rData.Find(What:=dStartDate, Lookat:=xlWhole, LookIn:=xlValues, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False).Row

'returns the row number of the EndDate
lEndDate = rData.Find(What:=dEndDate, Lookat:=xlWhole, LookIn:=xlValues, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False).Row

'combines to form the final range
sFinalRange = sColumnNbr & lEndDate & ":" & sColumnNbr & lStartDate

'returns the column number to the calling procedure.  If the first character of the string is a number returns NA
If IsNumeric(Mid(sFinalRange, 1, 1)) Then
    GetSumFromWorksheet = "N/A"
Else
    GetSumFromWorksheet = sFinalRange
End If
    
End Function
 
Upvote 0
Gremlins? Also, the manual search on the sheet needed "By Values" selected and then it went straight to "ACFEED_AC_Ni" so I figured I'd put in that value in the parameter list of the Find function. But I think it was more the gremlins.
 
Upvote 0
It's a good idea to include LookIn:=xlValues in the parameters, but that shouldn't have made a difference since your tags are constants, not formulas.

Good progress on your code. :) A couple of minor comments on your latest version.

Code:
Function GetSumFromWorksheet(sLookUpTag As String, dStartDate As Date, dEndDate As Date) As String
[COLOR="#0000FF"]' My preference is to use the prefix "dt" for Date types, since I use "d" for Double types. 
'There is no standard though, so you can use whichever you like as long as you are consistent.[/COLOR]

'--this function returns the summation at this point in the process using the arguments to find the worksheet range
'--(for now) this function returns the column number of the tag which will be above the dta to be summed.

Dim lColumnNbr As Long
Dim lStartDate As Long
Dim lEndDate As Long
Dim sColumnNbr As String
Dim sFinalRange As String
Dim rHeaders As Range
Dim rData As Range
Dim wks As Worksheet
Set wks = Worksheets("EBal")
Set rHeaders = wks.Range("rngHeaders")
Set rData = wks.Range("A:A")

Application.FindFormat.Clear  [COLOR="#0000FF"]' this can be removed. it clears formatting saved in the 
' prior Find by Format. Your use of SearchFormat:=False makes this unnecessary.[/COLOR]

On Error Resume Next

'returns the correct column number/letter referenced from the 'A' column
lColumnNbr = rHeaders.Find(What:=sLookUpTag, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False).Column
sColumnNbr = Split(Cells(1, lColumnNbr).Address, "$")(1) 
[COLOR="#0000FF"]' I think it's simpler and cleaner to use the column number and row numbers to 
' define a range, instead of converting to column letters.[/COLOR]

On Error GoTo 0
Application.FindFormat.Clear  [COLOR="#0000FF"]' this can be removed.[/COLOR]

[COLOR="#0000FF"]' Consider adding code to handle the scenario that the Start or End Date isn't found.[/COLOR]
'returns the row number of the StartDate
lStartDate = rData.Find(What:=dStartDate, Lookat:=xlWhole, LookIn:=xlValues, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False).Row

'returns the row number of the EndDate
lEndDate = rData.Find(What:=dEndDate, Lookat:=xlWhole, LookIn:=xlValues, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False).Row

'combines to form the final range
[COLOR="#0000FF"]' For the next step of development:
 1. Use the row and column numbers to set a Range object instead of a String
 2. Get a sum of the range using Application.Sum(YourRange)
 3. Test that sum is a valid number
 4. Modify the declaration of this function to return the sum as a Double type.
[/COLOR]

sFinalRange = sColumnNbr & lEndDate & ":" & sColumnNbr & lStartDate

'returns the column number to the calling procedure.  If the first character of the string is a number returns NA
If IsNumeric(Mid(sFinalRange, 1, 1)) Then
    GetSumFromWorksheet = "N/A"
Else
    GetSumFromWorksheet = sFinalRange
End If
    
End Function
 
Last edited:
Upvote 0
If you click on the lookup tag on Sheet"EBal", you'll see that they are not values but indeed concatenate formulae all the way across row2. So yeah, will move forward with your suggestions. Will report back soon.

As for suggestion to add code to handle dates that aren't found, I plan to restrict the max and min dates (in userform initialization to the first and last date).
 
Last edited:
Upvote 0
Not having the xlValues parameter explains the results you were getting then. It explains why "ACFEED_AC_" was found, when the full tags weren't because you didn't have "entire contents" checked on your manual test.

Sorry that I didn't suggest checking that earlier. The tags in row 2 were not formulas in the version of the file that you sent to me.
 
Upvote 0

Forum statistics

Threads
1,224,827
Messages
6,181,198
Members
453,022
Latest member
RobertV1609

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top