Automatic charting of any medical cell data when clicked - is it possible?

[fsgregs]

Hi. I am a true novice in Excel and if the question has already been answered, please forgive the repeat. I have created a log of all my medical blood and urine tests over time. In total, the log contains about 30 different tests, such as Glucose, Bun, HDL, Total Cholesterol, etc. Entries are made by date, which tracks downward in rows, with the appropriate values entered in each column. For example, entries might look like this:

Date ...... Glucose ....... BUN
..................plot ........... plot

3/4/2016 .....88 ............ 21
5/6/2016 .... 91 ............ 28 ....etc.
2/3/2017 .....84 .............19
5/12/2017 ...79 .............23

Medical data is of limited value unless trends can be spotted. As such, I would like to be able to set up a formula/function to automatically chart/plot/graph the data in a given column over time. When I click on the word, "plot" under Glucose, for example, the function in that cell is called, and does the following:

a) Examines all the values in the Glucose column and finds the lowest value, and the highest value (e.g. - 79,91)
b) Creates a line graph with those two values +/- 20% as the min and max values of the Y axis
c) Examines the dates in the Date column and finds the earliest value and the most recent values (perhaps dates can be converted to Julian numbers via a 2nd sub-routine for ease of use)
d) Sets those two data points +/- 20% as the min and max values of the X axis
e) Grabs the text "Glucose" and sets it as the Y axis title
f) Grabs the text "Date" and sets it as the X axis title
g) Plots the values in that column as a line graph, that pops up as a sub-menu automatically


In short, by clicking on the word, "Plot" under any blood test results, a line graph of that data will automatically be created and pop up, with the x and y axis automatically created by the sub-routine. I presume a few other parameters in the plot would also have to be specified in advance (rounding, etc.)

This would be such a useful, elegant spreadsheet that it could be posted publicly for free for everyone to use. Can such a sub-routine/function formula be created and inserted into Excel? If so, could someone point me toward the info I would need to do so, or be willing to give me some pointers?

Thanks in advance

Frank

 

[Worf]

Welcome to the Board
Tell me if you don’t know how to implement the code below:

Excel Workbook
	A	B	C
1	Date	Glucose	BUN
2		plot	plot
3	04/07/2015	70,0	13
4	04/09/2015	72,0	15
5	05/11/2015	74,0	17
6	06/01/2016	76,0	19
7	08/03/2016	78,0	21
8	09/05/2016	80,0	23
9	10/07/2016	82,0	25
10	10/09/2016	84,0	27
end

' sheet module
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim L$, lr%, co As ChartObject, ser As Series
L = Replace(Split(Target.Address, "$")(1), ":", "")
If Target.Row = 2 And Evaluate("=count(" & L & ":" & L & ")") > 2 Then
    lr = Me.Range(L & Rows.Count).End(xlUp).Row
    Set co = Me.ChartObjects.Add(Left:=Me.Cells(1, 2).Left, _
    Width:=Me.[B1:L1].Width, Top:=Me.Cells(3, 2).Top, Height:=Me.[A2:A22].Height)
    With co.Chart
        .HasLegend = False
        .Axes(xlValue).MaximumScale = Evaluate("=max(" & L & ":" & L & ")") * 1.2
        .Axes(xlValue).MinimumScale = Evaluate("=min(" & L & ":" & L & ")") * 0.8
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Text = Me.Range(L & "1")
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Text = Me.[a1]
        Set ser = .SeriesCollection.NewSeries
        With ser
            .Values = Me.Range(L & "3:" & L & lr)
            .XValues = Me.Range("a3:a" & lr)
            .ChartType = xlLineMarkers
        End With
    End With
End If
End Sub

 

[fsgregs]

Worf:

Wow, it appears from your post that it is possible to enter a sub-routine into a cell that will automatically create and draw a line graph of the data in the cell, plotted against another column with dates. That is fantastic and I truly appreciate the time it took you to write the routine. To answer your question, I do not know how to enter or implement the above routine. How do I click in the "plot" cell to enter the above code? Is there some tab I must click first (in Windows 10/Excel 2016)?

Secondly, to use the code for the next column of data (BUN), or the column after that (Hematocrit), etc., which lines in the code do I edit?

Thanks in advance

Frank

 

[Worf]

Hi Frank

· With Excel open, press alt+F11 to go to the VBE.
· On the left pane, right click your sheet name and choose view code.
· On the right pane, paste the code. Press alt+F11 to go back to the workbook window.
· This is it. Activating any of the plot cells will automatically create the corresponding chart for that column. The charts are placed on top of each other,how would you like this to be done?
· If needed,I can post a link to my test workbook.

 

[fsgregs]

Worf: I am impressed by your ability to create a macro that can automatically plot medical data values on a chart that pops up.

OK, first, the code you developed will need some tweaking to work with the worksheet I developed.

I have tried to paste a screenshot of a portion of my workbook here, but the image is not showing up, so here is a web link to it: https://www.dropbox.com/s/xkczxateq1f7khm/Capture.jpg?dl=0

First, I plugged in your macro and tried it out. In my actual worksheet, the word, "Plot" for Glucose is in cell D8, and the data begins in cell D10. The word "Plot" for BUN is in cell O8, and the data begins in cell O10. In your macro, what lines do I change to enable me to click on either D8 or O8 (or F8 for another blood test), and have any of the words generate a new plot beginning with data in row 10 of that column?

Second, I managed to change your macro code " If Target.Row = 2", into "If Target.Row = 8". and when I clicked on the word, "Plot", I did get a chart. However, there was no X axis with dates displayed. The plot simply left off the X axis, so obviously I need to make other changes. What would they be?

Third, when my test plot did appear, it was larger than the worksheet page and when I tried to scroll the screen down to see the lower end of the plot, it became displayed behind the data sheet. I could not see the plot anymore. How do we keep the plot on top (until we close it)?

Fourth, the only way to get the plot to go away once generated and return to the worksheet was to right-click on it, and "cut it". It is a minor thing, but is there a line of code that could close the plot more simply? Alternatively, could I generate the plot on a different page of the workbook (say a "Chart) page? If so, will the chart refresh dynamically, or will I have to close it and regenerate it whenever I change data in the workbook?

Fifth, I tried clicking on the word, "Plot" for BUN values in row O8, but no chart generated. What lines in the macro direct it to look for "Plot" entries in any cells in row 8?

Sorry for all the questions, but by fixing these tweaks, this macro may become so very useful to anyone who wants to generate automatic plots based on data. You have been most helpful.

Thanks again
Frank

 

[Worf]

1) Code amended.
2) Code amended.
3) The chart’s position and size are set on the code; you can change that to fit your typical window size. It can also be displayed on another sheet.
4) Charts may appear on chart sheets or embedded on regular worksheets. We can have dynamic charts without VBA: Create a Dynamic Chart
5) Code amended.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim L$, lr%, co As ChartObject, ser As Series
L = Replace(Split(Target.Address, "$")(1), ":", "")
If Target.Row = 8 And Evaluate("=count(" & L & ":" & L & ")") > 0 And Trim(Target) = "plot" Then
    If Me.ChartObjects.Count > 0 Then Me.ChartObjects.Delete    ' get rid of previous chart
    lr = Me.Range(L & Rows.Count).End(xlUp).Row
    Set co = Me.ChartObjects.Add(Left:=Me.[b2].Left, _
    Width:=Me.[B1:L1].Width, Top:=Me.[c11].Top, Height:=Me.[A2:A18].Height)  ' position & size
    With co.Chart
        .HasLegend = False
        .Axes(xlValue).MaximumScale = Evaluate("=max(" & L & ":" & L & ")") * 1.2
        .Axes(xlValue).MinimumScale = Evaluate("=min(" & L & ":" & L & ")") * 0.8
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Text = Me.Range(L & "6")   ' Y values
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Text = Me.[b6]          ' dates
        Set ser = .SeriesCollection.NewSeries
        With ser
            .Values = Me.Range(L & "10:" & L & lr)          ' Y values
            .XValues = Me.Range("b10:b" & lr)               ' X values
            .ChartType = xlLineMarkers
        End With
    End With
End If
End Sub

 

[fsgregs]

Wolf:
The code works beautifully. I was able to learn what edit to insert the macro on different pages of my medical log workbook. Thanks so much for the design.

One last question. Currently, the macro produces decimal fractions as values in the Y axis. What would I change to round the Y axis to the nearest convenient "even" integer (e.g. instead of an axis value of 10.8 showing up, it would round to 12)?

Frank

 

[Worf]

Hi Frank

You can change the unit values I hardcoded below to see what happens. Note that these values could also be calculated, based on the data at that column.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim L$, lr%, co As ChartObject, ser As Series
L = Replace(Split(Target.Address, "$")(1), ":", "")
If Target.Row = 8 And Evaluate("=count(" & L & ":" & L & ")") > 0 And Trim(Target) = "plot" Then
    If Me.ChartObjects.Count > 0 Then Me.ChartObjects.Delete    ' get rid of previous chart
    lr = Me.Range(L & Rows.Count).End(xlUp).Row
    Set co = Me.ChartObjects.Add(Left:=Me.[b2].Left, _
    Width:=Me.[B1:L1].Width, Top:=Me.[c11].Top, Height:=Me.[A2:A18].Height)  ' position & size
    With co.Chart
        .HasLegend = False
        With .Axes(xlValue)
            .MaximumScale = [COLOR=#ff8c00]Round[/COLOR](Evaluate("=max(" & L & ":" & L & ")") * 1.2, 0)
            .MinimumScale = Round(Evaluate("=min(" & L & ":" & L & ")") * 0.8, 0)
            .HasTitle = True
            .AxisTitle.Text = Me.Range(L & "6")   ' Y values
            .MajorUnit = 10
            .MinorUnit = 2
        End With
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Text = Me.[b6]          ' dates
        Set ser = .SeriesCollection.NewSeries
        With ser
            .Values = Me.Range(L & "10:" & L & lr)          ' Y values
            .XValues = Me.Range("b10:b" & lr)               ' X values
            .ChartType = xlLineMarkers
        End With
    End With
End If
End Sub

 

[fsgregs]

Wolf:

Your rounding routine works nicely, but I am discovering a problem with the axis major and minor unit values. In the medical blood test data, some tests on a single page of the worksheet that a macro would apply to, have expected larger values such as 40 or 200 or even 2000. In those cases, the Y axis range values could be set at 1.2 or 0.8 of min and max values as usual, but the Major unit increments would need to be larger, such as 10 or 100, and Minor unit increments of 2 or 20. However, some blood values on the same page have very low expected values, such as 0.2 or 1 or 3.3. In those cases, the Y axis that is created with large major and minor unit values, would only be a single value, because the Major unit of 10 and minor unit increments of 2, are too large. In those cases, we would need some kind of If/Then statement added to test for range of the data. For example, if the Min and max values are > 1000, then the Major Unit assigned to the plot could be 100 and the Minor unit could be 20. Else ... if the Min and max values are >100 but <1000, then the Major unit could be 50 and the minor unit set at 10 ... ELSE .. if the Min and max values are >10 but <100, then the Major unit could be 10 and the minor unit set at 1 ... Else ... if the Min and max values are >1 but <10, then the Major Unit would be 0.2 units and the minor unit 0.1 (or something suitable), etc. It would be a larger if/else/then statement with 5 or 6 lines, but it is doable. I would try to insert this myself in the Macro, but alas, I have zero experience with macro language and do not know how to insert If/Else/Then statements into the Macro "in the correct format".

Alternatively, you also said the Major Units and Minor Units and range of the Y axis could be calculated, based on the data within the table. That seems like it could be efficient, but could get complicated. Setting the range at 1.2 and 0.8 still works fine, but we would want the major and minor units to be rounded whole numbers, so taking a percentage of the min and max values would only work if they too used a rounding function. For example, if the data range in the table was 28 - 48, then the max value for the Y axis would be 48 x 1.2 = 57.6, rounded up to 58. The min value would be 28 x 0.8 = 22.4, rounded down to 22. With an axis range of 22 - 58, we could set the major unit at 10% of 58, = 5.8, rounded to 6. The minor unit might be 5% of 22 = 1.1, rounded down to 1.

What if the data range was 0.2 - 6.5? The max value for the Y axis would be 6.5 x 1.2 = 7.8, rounded up to 8. The min value would be 0.2 x 0.8 = 0.16, rounded down to 0.1. So what do we set the major and minor units at? 10% of 8 = 0.8, rounded up to 1. However, 5% of 0.1 = 0.005, rounded down to 0.004, which seems way too small to be an axis unit. I'm not sure what this graph would look like, but i suspect there would be too many axis units. What do you think? I am very open to your recommendations.

Frank

 

[Worf]

Since you are working with different data sets, calculating seems adequate, please test new version below. It currently uses a minimum major unit of one; will you need something smaller than this for any column?
I added data labels, see if you like them.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim L$, lr%, co As ChartObject, ser As Series, maxs#, mins#, step#
L = Replace(Split(Target.Address, "$")(1), ":", "")
If Target.Row = 8 And Evaluate("=count(" & L & ":" & L & ")") > 0 And Trim(Target) = "plot" Then
    If Me.ChartObjects.count > 0 Then Me.ChartObjects.Delete    ' get rid of previous chart
    lr = Me.Range(L & Rows.count).End(xlUp).Row
    Set co = Me.ChartObjects.Add(Left:=Me.[b2].Left, _
    Width:=Me.[B1:L1].Width, Top:=Me.[c11].Top, Height:=Me.[A2:A18].Height)  ' position & size
    With co.Chart
        .HasLegend = False
        With .Axes(xlValue)
            maxs = Round(Evaluate("=max(" & L & ":" & L & ")") * 1.2, 0)
            mins = Round(Evaluate("=min(" & L & ":" & L & ")") * 0.8, 0)
            .MaximumScale = maxs
            .MinimumScale = mins
            .HasTitle = True
            .AxisTitle.Text = Me.Range(L & "6")             ' Y values
            step = Round((maxs - mins) / 10, 0)
            .MajorUnit = IIf(step <> 0, step, 1)
        End With
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Text = Me.[b6]          ' dates
        Set ser = .SeriesCollection.NewSeries
        With ser
            .Values = Me.Range(L & "10:" & L & lr)          ' Y values
            .XValues = Me.Range("b10:b" & lr)               ' X values
            .ChartType = xlLineMarkers
            .ApplyDataLabels
            .DataLabels.Position = xlLabelPositionBelow
        End With
    End With
End If
End Sub