I have a worksheet in which I require the average of a range of cells to be calcluated and applied to a designated cell as each new record is added to the worksheet. Currently, I have copied a formula to a number of rows, however this means that I need to manually copy this formula as the number of records increases.
Is it possible for the calculated average to be added to the designated cell as each new record is added in the same code that adds the new record via a command button of might a separate macro need to be run?
Additionally, the average record will amended during the day as addition as information becomes available - Blood Sugar Readings Morning (Initial New record) & Midday and Evening (Updated Records).
Morning = Column G
*Midday = Column H
*Evening = Column I
*Average = Column J
* The value of these columns will change during the day so the code must work at input and update.
If this can be achieved through the command button, then I will subsequently need similar code to apply an average to a range of the new / updated record and the 6 previous records. Something for another post maybe
Any help will be gratefully received
www.dropbox.com
Is it possible for the calculated average to be added to the designated cell as each new record is added in the same code that adds the new record via a command button of might a separate macro need to be run?
Additionally, the average record will amended during the day as addition as information becomes available - Blood Sugar Readings Morning (Initial New record) & Midday and Evening (Updated Records).
Morning = Column G
*Midday = Column H
*Evening = Column I
*Average = Column J
* The value of these columns will change during the day so the code must work at input and update.
If this can be achieved through the command button, then I will subsequently need similar code to apply an average to a range of the new / updated record and the 6 previous records. Something for another post maybe
VBA Code:
Dim CurrentRow As Long
Dim wsHealthStatistics As Worksheet
Private Sub UserForm_Initialize()
Set wsHealthStatistics = ThisWorkbook.Worksheets("Daily Records")
Call cmdClearForm_Click
End Sub
Private Sub cmdInputRecord_Click()
Dim answer As VbMsgBoxResult
Dim AddRecord As Boolean
AddRecord = Val(Me.cmdInputRecord.Tag) = xlAdd
answer = MsgBox(IIf(AddRecord, "Add New", "Update Current") & " Record?", 36, "Information")
If answer = vbYes Then
If AddRecord Then CurrentRow = wsHealthStatistics.Range("A" & wsHealthStatistics.Rows.Count).End(xlUp).Row + 1
On Error GoTo myerror
With wsHealthStatistics
.Cells(CurrentRow, 1).Value = DTPicker1.Value
.Cells(CurrentRow, 2).Value = txtWeight.Value
.Cells(CurrentRow, 3).Value = txtBloodOxygen.Value
.Cells(CurrentRow, 4).Value = txtPulseRate.Value
.Cells(CurrentRow, 5).Value = txtBPSystolic.Value
.Cells(CurrentRow, 6).Value = txtBPDiastolic.Value
.Cells(CurrentRow, 7).Value = txtBGMorning.Value
.Cells(CurrentRow, 8).Value = txtBGMidday.Value
.Cells(CurrentRow, 9).Value = txtBGEvening.Value
.Cells(CurrentRow, 15).Value = txtDailySteps.Value
End With
MsgBox "Record has been " & IIf(AddRecord, "added", "Updated") & " to the database", 64, "Information"
End If
'Scroll the visible worksheet to lst 20 rows. ONLY FUNCTIONS ONCE THERE ARE 20 LINES OF INFORMATION
'With ActiveSheet
'Application.GoTo Reference:=.Cells(.Rows.Count, "A").End(xlUp).Offset(-20), Scroll:=True
'End With
Call cmdClearForm_Click
DTPicker1.SetFocus
myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub
Private Sub cmdCallRecord_Click()
'Used to call a record based on a date value
Dim rng As Range
Dim Res As Variant, myfind As Variant
Set rng = wsHealthStatistics.Range("A:A")
myfind = Me.DTPicker1.Value
If Not IsDate(myfind) Then Exit Sub
myfind = CDate(myfind)
Res = Application.Match(CLng(myfind), rng, 0)
If Not IsError(Res) Then
CurrentRow = CLng(Res)
With wsHealthStatistics
DTPicker1.Value = .Cells(CurrentRow, 1)
txtWeight.Value = .Cells(CurrentRow, 2)
txtBloodOxygen.Value = .Cells(CurrentRow, 3)
txtPulseRate.Value = .Cells(CurrentRow, 4)
txtBPSystolic.Value = .Cells(CurrentRow, 5)
txtBPDiastolic.Value = .Cells(CurrentRow, 6)
txtBGMorning.Value = .Cells(CurrentRow, 7)
txtBGMidday.Value = .Cells(CurrentRow, 8)
txtBGEvening.Value = .Cells(CurrentRow, 9)
txtDailySteps.Value = .Cells(CurrentRow, 15)
End With
'Update submit commandbutton ststus
With Me.cmdInputRecord
.Tag = xlUpdateState
.Caption = "Update"
.BackColor = rgbGreen
End With
Else
MsgBox "Date Not Found", vbInformation, "Date Not Found"
End If
End Sub
'Private Sub txtWeight_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'txtWeight = Format(TextBox1, "#,##0.0")
'End Sub
'Private Sub txtBloodOxygen_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'txtBloodOxygen = Format(TextBox1, "#,##0.0")
'End Sub
'Private Sub txtPulseRate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'txtPulseRate = Format(TextBox1, "#,##0.0")
'End Sub
'Private Sub txtBPSystolic_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'txtBPSystolic = Format(TextBox1, "#,##0.0")
'End Sub
'Private Sub txtBPDiastolic_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'txtBPDiastolic = Format(TextBox1, "#,##0.0")
'End Sub
'Private Sub txtBGMorning_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'txtBGMorning = Format(TextBox1, "#,##0.0")
'End Sub
'Private Sub txtBGMidday_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'txtBGMidday = Format(TextBox1, "#,##0.0")
'End Sub
'Private Sub txtBGEvening_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'txtBGEvening = Format(TextBox1, "#,##0.0")
'End Sub
'Private Sub txtDailySteps_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'txtDailySteps = Format(TextBox1, "#,##0.0")
'End Sub
Private Sub cmdClearForm_Click()
'Clears the User Form
DTPicker1.Value = ""
txtWeight.Value = ""
txtBloodOxygen.Value = ""
txtPulseRate.Value = ""
txtBPSystolic.Value = ""
txtBPDiastolic.Value = ""
txtBGMorning.Value = ""
txtBGMidday.Value = ""
txtBGEvening.Value = ""
txtDailySteps.Value = ""
DTPicker1.SetFocus
With Me.cmdInputRecord
.Tag = xlAdd
.Caption = "Add Record"
.BackColor = rgbYellow
End With
End Sub
Private Sub cmdCloseForm_Click()
Unload Me
End SubAny help will be gratefully received
