Sequential Numbering of New Records using VBA

D

Denny57

Board Regular
Joined
Nov 23, 2015
Messages
246
Office Version
  1. 365
Platform
  1. Windows
I have a worksheet which will be used to stored daily medical statistics, updated throughot the day. As the number of rows are known (365) I have a unique point of reference to use when updating records dujring the day.

I have 2 options.

Option 1 is to pre load each row with the calendar day (1st Jan = 1, 2nd Jan = 2 etc... I should then be able to use this as a key to review and update daily information.
Option 2 would be to apply a sequential number to column A of each daily record when initial details are added via the user form using a command button.

I have tried to use option 1 but for some reason the code cannot find a match so I can only assume that as the Day Number was not added through a user form, that the search and data records are incompatible (despite changing the format). The code fails at the "Match" stage

VBA Code: 
Private Sub cmdViewByDay_Click()
Worksheets("Daily Statistics").Activate
Dim Res As Variant
Dim Lastrow
Dim myFind As String

    Res = Application.Match(txtDayNumber, Sheets("Daily Statistics").Range("A4:A70"), 0)
        If IsError(Res) Then
            MsgBox "Day Number Not Found", vbInformation, "Day Number Not Found"
     Call UserForm_Initialize
     txtDayNumber.SetFocus
    Exit Sub
    End If

   Lastrow = Sheets("Daily Statistics").Range("A" & Rows.Count).End(xlUp).Row
    myFind = txtDayNumber
    For Currentrow = 2 To Lastrow
    If Cells(Currentrow, 1).Text = myFind Then
    txtDayNumber.Value = ActiveSheet.Cells(Currentrow, 1).Value
    txtDate.Value = ActiveSheet.Cells(Currentrow, 2).Value
    txtWeight.Value = ActiveSheet.Cells(Currentrow, 3).Value
    txtBPSystolic = ActiveSheet.Cells(Currentrow, 11).Value
    txtBPDiastolic = ActiveSheet.Cells(Currentrow, 12).Value
    txtPulse = ActiveSheet.Cells(Currentrow, 13).Value
    txtBloodOxygen = ActiveSheet.Cells(Currentrow, 14).Value
    txtMorning = ActiveSheet.Cells(Currentrow, 15).Value
    txtMidday = ActiveSheet.Cells(Currentrow, 16).Value
    txtEvening = ActiveSheet.Cells(Currentrow, 17).Value
        Exit For
    End If
    Next Currentrow
    txtDayNumber.SetFocus

Option 2 would be to add the sequential "Day" number to column A in each row when a new record is added via a Command Button

Current Code to add a new record

VBA Code: 
Private Sub cmdAddRecord_Click()
Worksheets("Daily Statistics").Activate
Dim Lastrow As Long

Lastrow = Sheets("Daily Statistics").Range("C" & Rows.Count).End(xlUp).Row
Cells(Lastrow + 1, "C").Value = txtWeight
Cells(Lastrow + 1, "K").Value = txtBPSystolic
Cells(Lastrow + 1, "L").Value = txtBPDiastolic
Cells(Lastrow + 1, "M").Value = txtPulse
Cells(Lastrow + 1, "N").Value = txtBloodOxygen
Cells(Lastrow + 1, "O").Value = txtMorning
'Cells(Lastrow + 1, "P").Value = txtMidday
'Cells(Lastrow + 1, "Q").Value = txtEvening
MsgBox "Records have been added to the database", 0, "Records Added"

Call UserForm_Initialize
txtWeight.SetFocus
End Sub

I would be grateful if someone might be able to either resolve the problem why the matching code will not work** or a resolution to add a sequential number to each new record added via the User Form.

** This code works perfectly in several other workbooks

Thanks In Advance
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
Hi,
untested but see if this update to your code resolves your issue

VBA Code: 
Private Sub cmdViewByDay_Click()
    Dim Res                 As Variant, Search As Variant
    Dim Currentrow          As Long
    Dim wsDailyStatistics   As Worksheet
   
    Set wsDailyStatistics = ThisWorkbook.Worksheets("Daily Statistics")
   
    Search = txtDayNumber
   
    If Len(Search) >  0 Then
   
        If IsNumeric(Search) Then Search = Val(Search)
       
        With wsDailyStatistics
           
            Res = Application.Match(Search, .Columns(1), 0)
           
            If IsError(Res) Then
               
                MsgBox "Day Number Not Found", vbInformation, "Day Number Not Found"
               
                Call UserForm_Initialize
               
            Else
               
                Currentrow = CLng(Res)
               
                txtDayNumber.Value = .Cells(Currentrow, 1).Value
                txtDate.Value = .Cells(Currentrow, 2).Value
                txtWeight.Value = .Cells(Currentrow, 3).Value
                txtBPSystolic = .Cells(Currentrow, 11).Value
                txtBPDiastolic = .Cells(Currentrow, 12).Value
                txtPulse = .Cells(Currentrow, 13).Value
                txtBloodOxygen = .Cells(Currentrow, 14).Value
                txtMorning = .Cells(Currentrow, 15).Value
                txtMidday = .Cells(Currentrow, 16).Value
                txtEvening = .Cells(Currentrow, 17).Value
               
            End If
           
        End With
    End If
   
    txtDayNumber.SetFocus
End Sub

Dave
 
Upvote 0
dmt32 said:
Hi,
untested but see if this update to your code resolves your issue

VBA Code: 
Private Sub cmdViewByDay_Click()
    Dim Res                 As Variant, Search As Variant
    Dim Currentrow          As Long
    Dim wsDailyStatistics   As Worksheet
  
    Set wsDailyStatistics = ThisWorkbook.Worksheets("Daily Statistics")
  
    Search = txtDayNumber
  
    If Len(Search) >  0 Then
  
        If IsNumeric(Search) Then Search = Val(Search)
      
        With wsDailyStatistics
          
            Res = Application.Match(Search, .Columns(1), 0)
          
            If IsError(Res) Then
              
                MsgBox "Day Number Not Found", vbInformation, "Day Number Not Found"
              
                Call UserForm_Initialize
              
            Else
              
                Currentrow = CLng(Res)
              
                txtDayNumber.Value = .Cells(Currentrow, 1).Value
                txtDate.Value = .Cells(Currentrow, 2).Value
                txtWeight.Value = .Cells(Currentrow, 3).Value
                txtBPSystolic = .Cells(Currentrow, 11).Value
                txtBPDiastolic = .Cells(Currentrow, 12).Value
                txtPulse = .Cells(Currentrow, 13).Value
                txtBloodOxygen = .Cells(Currentrow, 14).Value
                txtMorning = .Cells(Currentrow, 15).Value
                txtMidday = .Cells(Currentrow, 16).Value
                txtEvening = .Cells(Currentrow, 17).Value
              
            End If
          
        End With
    End If
  
    txtDayNumber.SetFocus
End Sub

Dave
Click to expand...
Dave Sorry for the delay... Ypur solution works perfectly.

Many thanks
 
Upvote 0
Denny57 said:
Dave Sorry for the delay... Ypur solution works perfectly.

Many thanks
Click to expand...
When marking a post as a solution, please be sure to mark the actual post that contains the solution, not your post acknowledging that some other post was the solution.
I have updated this for you.
 
Upvote 0
Joe4 said:
When marking a post as a solution, please be sure to mark the actual post that contains the solution, not your post acknowledging that some other post was the solution.
I have updated this for you.
Click to expand...
Dave I have encountered a problem when I try to update after recalling data through the solution you kindly provided.

I am using the same code format to update records in a number of files but for some reason this code now fails at the first record to be updated. This happens even if I exclude lines from beng updated.

VBA Code: 
Private Sub cmdUpdate_Click()

answer = MsgBox("Update the record?", vbYesNo + vbQuestion, "Update Record?")
If answer = vbNo Then
Call UserForm_Initialize
txtWeight.SetFocus

Else
'Cells(Currentrow, 1).Value = txtDayNumber
'Cells(Currentrow, 2).Value = txtDate
Cells(Currentrow, 3).Value = txtWeight.Value
Cells(Currentrow, 11).Value = txtBPSystolic.Value
Cells(Currentrow, 12).Value = txtBPDiastolic.Value
Cells(Currentrow, 13).Value = txtPulse.Value
Cells(Currentrow, 14).Value = txtBloodOxygen.Value
Cells(Currentrow, 15).Value = txtMorning.Value
Cells(Currentrow, 16).Value = txtMidday.Value
Cells(Currentrow, 17).Value = txtEvening.Value

MsgBox "Record has been updated", 0, "Record Updated"

'With Sheets("Daily Statistics").Range("O4:Q370")
'.NumberFormat = "General"
'.Value = .Value
'End With

Call UserForm_Initialize

txtWeight.SetFocus
End If

End Sub

I have tried with activating the worksheet and beginning each line for updacting with "ActiveSheet"
I have even omitted .Value after the textbox names.

Might there be something in the way that information is being recalled that needs to be included when records are updated.

Thank you for any help you can provide
 
Upvote 0
dmt32 said:
Glad update resolved your issue & appreciate the feedback

Dave
Click to expand...
Hi Dave

It appears that my message might have been delayed.

I have posted that I now cannot update records once they have been viewed following their recall to the User Form. The same code syntax is currently working fine in other files.

Hoping you might be able to identify something from your code which might need to be added to the Update Code to get this to work.

Many thanks

David
 
Upvote 0
I ought perhaps to advise that I get the following message

Runtime Error 1004 Application defined or object defined error?

I am trying to identify which values are cauding the error , but this module fails at every "active" line to be updated.
 
Upvote 0
Denny57 said:
Dave I have encountered a problem when I try to update after recalling data through the solution you kindly provided.

I am using the same code format to update records in a number of files but for some reason this code now fails at the first record to be updated.
Click to expand...

Hi,
try following updates to your codes & see if resolves for you

Rich (BB code): 
Option Explicit
Dim wsDailyStatistics   As Worksheet
Dim Currentrow          As Long

Private Sub cmdViewByDay_Click()

    Dim Res                 As Variant, Search As Variant
    
    Search = txtDayNumber
    
    If Len(Search) > 0 Then
    
        If IsNumeric(Search) Then Search = Val(Search)
        
        With wsDailyStatistics
            
            Res = Application.Match(Search, .Columns(1), 0)
            
            If IsError(Res) Then
                
                MsgBox "Day Number Not Found", vbInformation, "Day Number Not Found"
                
                Call UserForm_Initialize
                
            Else
                
                Currentrow = CLng(Res)
                
                txtDayNumber.Value = .Cells(Currentrow, 1).Value
                txtDate.Value = .Cells(Currentrow, 2).Value
                txtWeight.Value = .Cells(Currentrow, 3).Value
                txtBPSystolic = .Cells(Currentrow, 11).Value
                txtBPDiastolic = .Cells(Currentrow, 12).Value
                txtPulse = .Cells(Currentrow, 13).Value
                txtBloodOxygen = .Cells(Currentrow, 14).Value
                txtMorning = .Cells(Currentrow, 15).Value
                txtMidday = .Cells(Currentrow, 16).Value
                txtEvening = .Cells(Currentrow, 17).Value
                
                cmdUpdate.Enabled = True
                
            End If
            
        End With
    End If
    
    txtDayNumber.SetFocus
End Sub

Private Sub cmdUpdate_Click()
    Dim answer      As VbMsgBoxResult
    
    answer = MsgBox("Update the record?", 36, "Update Record?")
    
    If answer = vbNo Then
    
        Call UserForm_Initialize
        txtWeight.SetFocus
        
    Else
        With wsDailyStatistics
            'Cells(Currentrow, 1).Value = txtDayNumber
            'Cells(Currentrow, 2).Value = txtDate
            .Cells(Currentrow, 3).Value = txtWeight.Value
            .Cells(Currentrow, 11).Value = txtBPSystolic.Value
            .Cells(Currentrow, 12).Value = txtBPDiastolic.Value
            .Cells(Currentrow, 13).Value = txtPulse.Value
            .Cells(Currentrow, 14).Value = txtBloodOxygen.Value
            .Cells(Currentrow, 15).Value = txtMorning.Value
            .Cells(Currentrow, 16).Value = txtMidday.Value
            .Cells(Currentrow, 17).Value = txtEvening.Value
        End With
        
        MsgBox "Record has been updated", 64, "Record Updated"
        
        Call UserForm_Initialize
        
        txtWeight.SetFocus
    End If
    
End Sub

Private Sub UserForm_Initialize()
     Set wsDailyStatistics = ThisWorkbook.Worksheets("Daily Statistics")
     cmdUpdate.Enabled = False

'other codes

End Sub

Note:
- the variables at top - These MUST be placed at very TOP of your userforms code page OUTSIDE any procedure.
- codes that need to be included in existing UserForm_Initialize event (shown in BOLD)

I have also added Option Explicit statement - this forces explicit declaration of all variables in the module - a good practice to follow.

Dave
 
Upvote 0
Solution
dmt32 said:
Set wsDailyStatistics = ThisWorkbook.Worksheets("Daily Statistics") cmdUpdate.Enabled = False
Click to expand...
Dave Once again thank you. Your solution works and I have tested a few different scenarios and all were successful..
What baffles me is that I was able to use the same look-up and update code in a number of similar files yet this time neither would work.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
VBA Code to Apply an AVERAGE of a Range on Cells as New Records are added Via a User Form
Replies
2
Views
90
Denny57
D
D
  • Solved
Error 1004
2
Replies
18
Views
401
dmt32
D
D
  • Question Question
Possible Use of CountIF and AVERAGE Functions
Replies
1
Views
185
Denny57
D
D
  • Solved
Numeric Value returned when Time format returned to User Form TextBox
Replies
3
Views
134
6StringJazzer
6StringJazzer
D
  • Solved
Date Issues with User Forms
Replies
4
Views
210
dmt32
D

Forum statistics

Threads
1,224,809
Messages
6,181,075
Members
453,020
Latest member
mattg2448

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top