'************************************************
 '<< Code for ThisWorkbook module >>
 
Option Explicit 
 
Private Sub Workbook_Open() 
     'hide the workbook
    Application.Visible = False 
     'display message
    MsgBox "On the form that appears next..." & vbNewLine & _ 
    vbNewLine & _ 
    "1) Scroll down and select your reading" & vbNewLine & _ 
    "2) Select an appropriate time" & vbNewLine & _ 
    "3) Write any notes" & vbNewLine & _ 
    "4) Click ENTER", , "Entering Blood Glucose Levels" 
     'show userform
    UserForm1.Show False 
End Sub 
 '************************************************
 
 
 '************************************************
 '<< Code for Module1 >>
 
Option Explicit 
 
Sub ShowForm() 
    Application.Visible = False 
    UserForm1.Show False 
End Sub 
 
 
Private Sub RemoveFromMenu() 
    On Error Resume Next '< error = no control
     '//remove right-click control
    With Application.CommandBars("Cell") 
        .Controls("Hide Book").Delete 
    End With 
End Sub 
 '************************************************
 
 
 '************************************************
 '<< Code for Userform1 module >>
 
Option Explicit 
 
Private Sub UserForm_Initialize() 
     'size & position all the controls
    With UserForm1 
        .Caption = "Select your reading and time then click ENTER" 
        .Height = 338 
        .Width = 232 
        .Top = 60 
        .Left = 180 
    End With 
    With ListBox1 
        .Height = 304 
        .Width = 40 
        .Top = 7 
        .Left = 7 
    End With 
    With ListBox2 
        .Height = 133 
        .Width = 166 
        .Top = 7 
        .Left = 54 
    End With 
    With Label1 
        .Height = 20 
        .Width = 166 
        .Top = 177 
        .Left = 54 
    End With 
    With TextBox1 
        .Height = 35 
        .Width = 166 
        .Top = 200 
        .Left = 54 
    End With 
    With CommandButton1 
        .Height = 30 
        .Width = 82 
        .Top = 245 
        .Left = 55 
    End With 
    With CommandButton2 
        .Height = 30 
        .Width = 82 
        .Top = 245 
        .Left = 138 
    End With 
    With CommandButton3 
        .Height = 34 
        .Width = 166 
        .Top = 275 
        .Left = 54 
    End With 
    DoEvents 
End Sub 
 
 
Private Sub UserForm_Activate() 
    Dim MyList(250), N& 
    With ListBox1 
        .ControlTipText = "Blood glucose reading in mmol/L" 
        .Font.Size = 8 
        .ColumnWidths = 10 
         'insert a list of possible glucose levels (1.0 to 26.0)
        For N = 0 To 250 
            MyList(N) = (N + 10) / 10 
        Next 
        .List = MyList 
        DoEvents 
    End With 
     'insert a list of broad times rel. to meals
    With ListBox2 
        .ControlTipText = "NOTE: It is recommended that readings be taken 2 hours after meals, " & _ 
        "if your ''after'' time differs from that, use ''notes''" 
        .AddItem "On waking / fasting" 
        .AddItem "Before breakfast" 
        .AddItem "After breakfast" 
        .AddItem "Before morning snack" 
        .AddItem "After morning snack" 
        .AddItem "Before midday meal" 
        .AddItem "After midday meal" 
        .AddItem "Before afternoon snack" 
        .AddItem "After afternoon snack" 
        .AddItem "Before evening meal" 
        .AddItem "After evening meal" 
        .AddItem "Before late-night snack" 
        .AddItem "After late-night snack" 
        DoEvents 
    End With 
     'put headings on sheet
    [A1] = "Reading (mmol/L)" 
    [B1] = "Time entered" 
    [C1] = "Date" 
    [D1] = "Reading relative to meal" 
    [E1] = "Notes" 
    [F1] = "Days Average" 
    ActiveWindow.FreezePanes = True 
End Sub 
 
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 
     'save and quit if X button clicked
    If CloseMode = 0 Then CommandButton3_Click 
End Sub 
 
 
Private Sub CommandButton1_Click() 
    Dim N&, ViewIt As Range 
     'need listboxes 1 and 2 to have readings
    If ListBox1 = Empty Or ListBox2 = Empty Then 
        Exit Sub 
    End If 
     'select row for entry
    With [A65536].End(xlUp) 
        If .Offset(0, 2) = Date Then 
             'same-date entry, next row
            N = 1 
        Else 
             'not the same-date, leave an empty row
            N = 2 
        End If 
        .Offset(N, 0) = ListBox1 '< reading
        If .Offset(N, 0) = Empty Then Exit Sub '<ENTER clicked twice
        .Offset(N, 1) = Format(Time, "hh:mm ampm") 
        .Offset(N, 2) = Format(Date, "dd mmm yy") 
        .Offset(N, 3) = ListBox2 '< rel. to meals
        .Offset(N, 4) = TextBox1 '< Notes
         'enter the average reading in column F
        If .Offset(N - 1, 0) = Empty Then 
            .Offset(N, 5) = .Offset(N, 0) 
        Else 
            .Offset(N, 5) = Format(WorksheetFunction.Average(.CurrentRegion.Columns(1)), "##.0") 
             'to avoid confusion clear the previous average
            .Offset(N - 1, 5).ClearContents 
        End If 
         'scroll up to only show last 10 rows of entries
         'avoid out-of-range errors when < 10 rows
        On Error Resume Next 
        Application.Goto .Offset(-6, 0).End(xlUp), Scroll:=True 
    End With 
     'tart up sheet a bit
    Cells.Columns.AutoFit 
     'clear all selections & text
    ListBox1 = Empty 
    ListBox2 = Empty 
    TextBox1 = Empty 
End Sub 
 
 
Private Sub CommandButton2_Click() 
     'edit or read past entries
     'remove any previous right-click control
    Run "RemoveFromMenu" 
     '//now add new right-click control
    With Application.CommandBars("Cell") 
        .Controls.Add(Type:=msoControlButton). _ 
        Caption = "Hide Book" 
         '//assign procedure to this control
        .Controls("Hide Book"). _ 
        OnAction = "ShowForm" 
    End With 
    Application.Visible = True 
    Unload Me 
End Sub 
 
 
Private Sub CommandButton3_Click() 
     'readings have been entered, save and quit
    Run "RemoveFromMenu" 
    ActiveWorkbook.Save 
    Unload Me 
    Application.Quit 
End Sub 
 '************************************************