Add an Incremental Numeric Value to a Column as Each New Record is Added

[Denny57]

Is there a line of code that can be used to apply an incremental number to a column each time a new record is added. Starting at 1 in Cell Reference Q5.
Records will be added via a User Form Command Button.

I have searched but have not been able to find anything that seems to be suitable

Many Thanks

 

[dreid1011]

Can you show us the userform code?

 

[Denny57]

Hope this helps
Please note that column Q does not appear at present. The actual file will start empty after the row headers

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 Sub

Dropbox

www.dropbox.com

 

[dreid1011]

You could add a line like this to start:

.Cells(CurrentRow, 17).Value = .Cells(CurrentRow-1,17).Value + 1

in the with statment:

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
        .Cells(CurrentRow, 17).Value = Cells(CurrentRow-1,17).Value + 1
    End With

Change the +1 to however much you want to increment, but you will have to manually add the values for the current data.

 

[Denny57]

You could add a line like this to start:

.Cells(CurrentRow, 17).Value = .Cells(CurrentRow-1,17).Value + 1

in the with statment:

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
        .Cells(CurrentRow, 17).Value = Cells(CurrentRow-1,17).Value + 1
    End With

Change the +1 to however much you want to increment, but you will have to manually add the values for the current data.

Thank You. Much Appreciated

 

[dreid1011]

You're welcome, and happy to help.