Possible Use of CountIF and AVERAGE Functions

[Denny57]

I am looking for some help creating VBA code that will allow me to average different ranges of information.

The sample file currently uses formula in those cells which are to contain the averages, however, this limits the number of rows into which data can be added as I need to manualyy copy the underlying formula.Ideally I am looking for some code that will apply the required average to the necessary cells as each record is added and updated.

Requirements
1) Average to be applied to a single row of data.
Initially a record will be written that will leave Columns H & I empty. Column J should contain the average of Columns G, H & I. Columns H & I will be updated subsequently and will recalculate the value of Column J.

2) Average to be applied to a single row of data using seven rows of Data
I am looking to maintain a 7-Day average in each row for in Columns K,L,M & N. These columns will be populated both at the time that the original record is added and again as each is updated.
The 7 rows are the row being added and the previos 6 rows

Both 1) and 2) will be actioned by the same command button execution.

I do have a further request for an average caluculation and which concerns Column Q. I would like to maintain this record as a point of reference although I expect that code can be written that would not require this detail.

Column O will contain the new data
Column P needs to be a SUM of Column O
Column Q requires to be an increment of 1 on the previous row
Column R will be the average of Column P and Column Q.

I expect this can be coded using COUNTIF and AVERAGE but my knowledge of VBA is not at a level to code this requirement.

I have "Commented" some of the code which I hoped would ensure that the text in these textboxes would be send as numberic but actually the details were not copied.

All help will be gratefully received

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 Sub

Dropbox

www.dropbox.com

 

[Denny57]

Closing Post and breaking down requirements in to separate posts