Sequential number generation

Paul15

New Member
Joined
Jun 25, 2020
Messages
44
Office Version
  1. 2019
Platform
  1. Windows
Hi Team,

I have used the code in question 965869 and can get a sequential number to populate via my user form to the required location on the spreadsheet, however this is writing to the spreadsheet before the other entered data is submitted to the sheet via the command button. This is forcing my remaining data to populate 1 line below the sequential number. Code is:

Private Sub CommandButton1_Click()
With ThisWorkbook.Worksheets("Sheet1")
.Cells(.Rows.Count, "A").End(xlUp).Offset(1) = TextBox1.Value
TextBox1.Text = Application.Max(.Range("A:A")) + 1
End With
End Sub

Private Sub UserForm_Initialize()
With ThisWorkbook.Worksheets("Sheet1")
TextBox1.Text = Application.Max(.Range("A:A")) + 1
End With
End Sub

If we can maybe change the sequence of events such that the generated number does not write to the sheet until the command button is pressed I think this might fix it

Any help please
 
Hi, Code for the whole system. I have also attached a screen shot of the issue where the sequential number goes to AS1 and the remaining submitted data to row 2



VBA Code:
Private Sub Age_Change()

End Sub

Private Sub ComboBox1_Change()

End Sub

Private Sub ComboBox2_Change()

End Sub

Private Sub ComboBox3_Change()

End Sub

Private Sub ComboBox4_Change()

End Sub

Private Sub CommandButton1_Click()

End Sub

Private Sub CommandCancel_Click()
    Unload Me
End Sub


Private Sub CommandClear_Click()

Unload Me
Form.Show


End Sub

Private Sub CTrefer1_Change()

End Sub

Private Sub date81_Change()

End Sub
Private Sub date81_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 'Ensures correct format for date of IS81 is entered
 If IsDate(date81.Value) = False Or Len(date81.Value) < 10 Then
 MsgBox ("Date must be entered dd/mm/yyyy")
 date81.Value = Null
 Cancel = True
 End If
 
End Sub

Private Sub departport2_Change()

End Sub

Private Sub docdetails_Change()

End Sub
Private Sub docdetails_AfterUpdate()

    Dim myRange As Range, f As Range

    Set myRange = Worksheets("FORMULAS").Range("R:S")

    Set f = myRange.Find(What:=docdetails.Value, LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False)
    If f Is Nothing Then
        FullNat.Value = ""
    Else
        FullNat.Value = f.Offset(, 1)
    End If


End Sub

Private Sub doctype_Change()

End Sub

Private Sub endcomments_Change()

End Sub

Private Sub Familyname_Change()

End Sub

Private Sub forgecode1_Change()

End Sub

Private Sub FullNat_Change()

End Sub

Private Sub genderlist_Change()

End Sub

Private Sub hoclearing_Change()

End Sub

Private Sub Minor_Change()

End Sub

Private Sub offclearing_Change()

End Sub

Private Sub outcome1_Change()

End Sub

Private Sub pncreason_Change()

End Sub

Private Sub Portref_Change()

End Sub

Private Sub reasonstop_Change()

End Sub

Private Sub Reasonstop2_Change()

End Sub

Private Sub Refusal_Change()

End Sub

Private Sub shipflight_Change()

End Sub

Private Sub SQNum_Change()

End Sub

Private Sub Stop1_Click()

End Sub

Private Sub TextBox1_Change()

End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 
'Ensure correct format of date of birth is entered
If IsDate(TextBox1.Value) = False Or Len(TextBox1.Value) < 10 Then
 MsgBox ("Date must be entered dd/mm/yyyy")
 TextBox1.Value = Null
 Cancel = True
 End If
 
 'Calculates age automatically and enters into Me.Age field
  If IsDate(Me.TextBox1.Value) Then
        Me.Age.Value = DateDiff("yyyy", DateValue(TextBox1.Value), Me.date81)
    End If
'Determines whether pax is minor and displays in Me.Minor field
If Me.Age.Value < 18 Then
Me.Minor.Value = "Yes"
End If
If Me.Age.Value > 17 Then
Me.Minor.Value = "No"
End If

 
End Sub


Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

'Clears the date of birth field when selected

If StrComp(TextBox1.Value, "DD/MM/YYYY", vbTextCompare) = 0 Then

     TextBox1.Value = ""

End If

End Sub


Private Sub Time1_Change()
Dim Char As String
    Char = Right(Time1.Text, 1)
    Select Case Len(Time1.Text)
    Case 1 To 2, 4 To 5
        If Char Like "#" Then
            If Len(Time1) = 1 Then
                If Val(Char) <= 2 Then Exit Sub
            ElseIf Len(Time1) = 2 Then
                If Val(Left(Time1.Text, 1) & Char) <= 23 Then Exit Sub
            ElseIf Len(Time1) = 4 Then
                If Val(Char) <= 5 Then Exit Sub
            Else
                Exit Sub
            End If
        End If
    Case 3
        If Char Like ":" Then Exit Sub
    End Select
    Beep
    On Error Resume Next
    Time1.Text = Left(Time1.Text, Len(Time1.Text) - 1)
    Time1.SelStart = Len(Time1.Text)
End Sub

Private Sub timepcp2_Change()
Dim Char As String
    Char = Right(timepcp2.Text, 1)
    Select Case Len(timepcp2.Text)
    Case 1 To 2, 4 To 5
        If Char Like "#" Then
            If Len(timepcp2) = 1 Then
                If Val(Char) <= 2 Then Exit Sub
            ElseIf Len(timepcp2) = 2 Then
                If Val(Left(timepcp2.Text, 1) & Char) <= 23 Then Exit Sub
            ElseIf Len(timepcp2) = 4 Then
                If Val(Char) <= 5 Then Exit Sub
            Else
                Exit Sub
            End If
        End If
    Case 3
        If Char Like ":" Then Exit Sub
    End Select
    Beep
    On Error Resume Next
    timepcp2.Text = Left(timepcp2.Text, Len(timepcp2.Text) - 1)
    timepcp2.SelStart = Len(timepcp2.Text)
End Sub

Private Sub TotalTime_Change()

End Sub

Private Sub Time1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Call Update_TotalTime
End Sub


Private Sub timepcp2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
   Call Update_TotalTime
End Sub

Private Sub Update_TotalTime()

    If Me.Time1.Value = "" Or Me.timepcp2.Value = "" Then
        Me.TotalTime.Value = "00:00"
    ElseIf Not IsDate(Me.Time1.Value) Then
        MsgBox "Invalid 'Start' time", vbExclamation, "Invalid Entry"
        Me.TotalTime.Value = "00:00"
    ElseIf Not IsDate(Me.timepcp2.Value) Then
        MsgBox "Invalid 'End' time", vbExclamation, "Invalid Entry"
        Me.TotalTime.Value = "00:00"
    ElseIf TimeValue(timepcp2.Value) < TimeValue(Time1.Value) Then
        MsgBox "'Time of inital stop' time occurs after 'Time Clear of PCP' time. If Time Clear of PCP is the next day then please amend Total ", vbExclamation, "Invalid Entries"
        Me.TotalTime.Value = "00:00"
    Else
        Me.TotalTime.Value = Format(TimeValue(Me.timepcp2.Value) - TimeValue(Me.Time1.Value), "hh:mm")
    End If
    
End Sub

Private Sub CID_Change()

End Sub


Private Sub UserForm_Initialize()
'Automatically adds the date and time into IS81 fields
Me.date81.Value = Format(Date, "dd/mm/yyyy")
Me.Time1.Value = Format(Time, "hh:mm")
'Me.timepcp2.Value = Format(Time, "hh:mm")

'**************************************

'Add sequential number to column AS

 With ThisWorkbook.Worksheets("IS81s")
        SQNum.Text = Application.Max(.Range("AS:AS")) + 1
    End With
    


    

    
'***********************************

'Displays the date of birth format required in Me.TextBox1 field
Me.TextBox1.Value = Format("DD/MM/YYYY")

End Sub



Private Sub CommandOK_Click()

'*************************************
'to add sequential number to column AS

With ThisWorkbook.Worksheets("IS81s")
        .Cells(.Rows.Count, "AS").End(xlUp).Offset(1) = SQNum.Value
        SQNum.Text = Application.Max(.Range("AS:AS")) + 1
    End With
    


   
'*********************************************

    
    
'Mandatory fields: Family name, Date of Birth, Gender, Nationality & Doc Type
If Me.Familyname.Value = "" Then
 
    MsgBox "You must complete family name", vbCritical
    Exit Sub
 
End If

If Me.TextBox1.Value = "" Then
 
    MsgBox "You must enter date of birth", vbCritical
    Exit Sub
 
End If
 
If Me.genderlist.Value = "" Then
 
    MsgBox "You must select gender", vbCritical
    Exit Sub
 
End If
If Me.docdetails.Value = "" Then
 
    MsgBox "You must select nationality", vbCritical
    Exit Sub
 
End If

If Me.doctype.Value = "" Then
 
    MsgBox "You must select document type", vbCritical
    Exit Sub
 
End If


'Dim RowCount As Long
'Dim ctl As Control

'If MsgBox("Are you sure all data has been correctly completed?", vbYesNo) = vbNo Then Exit Sub

RowCount = Worksheets("IS81s").Range("A1").CurrentRegion.Rows.Count
With Worksheets("IS81s").Range("A1")

    .Offset(RowCount, 0).Value = Me.date81.Value
    .Offset(RowCount, 1).Value = Me.Familyname.Value
    .Offset(RowCount, 2).Value = Me.TextBox1.Value
    .Offset(RowCount, 3).Value = Me.Age.Value
    .Offset(RowCount, 4).Value = Me.Minor.Value
    .Offset(RowCount, 5).Value = Me.genderlist.Value
    .Offset(RowCount, 6).Value = Me.docdetails.Value
    .Offset(RowCount, 7).Value = Me.FullNat.Value
    .Offset(RowCount, 8).Value = Me.doctype.Value
    .Offset(RowCount, 9).Value = Me.departport2.Value
    .Offset(RowCount, 10).Value = Me.shipflight.Value
    .Offset(RowCount, 12).Value = Me.Time1.Value
    .Offset(RowCount, 13).Value = Me.ComboBox2.Value
    .Offset(RowCount, 14).Value = Me.ComboBox1.Value
    .Offset(RowCount, 17).Value = Me.Vuln.Value
    .Offset(RowCount, 18).Value = Me.reasonstop.Value
    .Offset(RowCount, 19).Value = Me.Reasonstop2.Value
    .Offset(RowCount, 21).Value = Me.ComboBox4.Value
    .Offset(RowCount, 22).Value = Me.forgecode1.Value
    .Offset(RowCount, 24).Value = Me.CTrefer1.Value
    .Offset(RowCount, 26).Value = Me.ComboBox3.Value
    .Offset(RowCount, 29).Value = Me.pncreason.Value
    .Offset(RowCount, 31).Value = Me.outcome1.Value
    .Offset(RowCount, 32).Value = Me.Refusal.Value
    .Offset(RowCount, 33).Value = Me.timepcp2.Value
    .Offset(RowCount, 34).Value = Me.TotalTime.Value
    .Offset(RowCount, 36).Value = Me.Portref.Value
    .Offset(RowCount, 37).Value = Me.offclearing.Value
    .Offset(RowCount, 38).Value = Me.hoclearing.Value
    .Offset(RowCount, 43).Value = Me.endcomments.Value
    
    '.........................................................................................
    ' This code is to return Yes or No into spreadsheet if CID reference is entered into Portref
        If Me.TotalTime.Value <= "00:15" Then
    .Offset(RowCount, 35).Value = "No"
    Else
    .Offset(RowCount, 35).Value = "Yes"
    End If
    '..........................................................................................
        
  If Me.yesis81.Value = True Then
        .Offset(RowCount, 11).Value = "Yes"
    Else
        .Offset(RowCount, 11).Value = "No"
End If

If Me.holdseat.Value = True Then
        .Offset(RowCount, 15).Value = "Yes"
    Else
        .Offset(RowCount, 15).Value = "No"
End If

If Me.PVoT2.Value = True Then
        .Offset(RowCount, 16).Value = "Yes"
    Else
        .Offset(RowCount, 16).Value = "No"
End If

If Me.asyyes.Value = True Then
        .Offset(RowCount, 20).Value = "Yes"
    Else
        .Offset(RowCount, 20).Value = "No"
End If

If Me.Vuln.Value = True Then
        .Offset(RowCount, 17).Value = "Yes"
    Else
        .Offset(RowCount, 17).Value = "No"
End If

If Me.CTYN.Value = True Then
        .Offset(RowCount, 23).Value = "Yes"
    Else
        .Offset(RowCount, 23).Value = "No"
        
End If


If Me.CustYN.Value = True Then
        .Offset(RowCount, 25).Value = "Yes"
    Else
        .Offset(RowCount, 25).Value = "No"
        
End If

If Me.fingeryes.Value = True Then
        .Offset(RowCount, 27).Value = "Yes"
    Else
        .Offset(RowCount, 27).Value = "No"
End If

If Me.PNC.Value = True Then
        .Offset(RowCount, 28).Value = "Yes"
    Else
        .Offset(RowCount, 28).Value = "No"
End If

If Me.bags.Value = True Then
        .Offset(RowCount, 30).Value = "Yes"
    Else
        .Offset(RowCount, 30).Value = "No"
End If

If Me.IEN.Value = True Then
        .Offset(RowCount, 40).Value = "Yes"
    Else
        .Offset(RowCount, 40).Value = "No"
End If

If Me.SO.Value = True Then
        .Offset(RowCount, 41).Value = "Yes"
    Else
        .Offset(RowCount, 41).Value = "No"
End If
    
   
  
    
End With





Call CommandClear_Click





End Sub
 
Upvote 0

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Ok, in the CommandOK sub add this line
Rich (BB code):
With Worksheets("IS81s").Range("A1")
    .Offset(RowCount, 44).value= SQNum.Value
    .Offset(RowCount, 0).Value = Me.date81.Value
And delete this from the start of the sub
VBA Code:
With ThisWorkbook.Worksheets("IS81s")
        .Cells(.Rows.Count, "AS").End(xlUp).Offset(1) = SQNum.Value
        SQNum.Text = Application.Max(.Range("AS:AS")) + 1
    End With
 
Upvote 0
Glad we could help & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,113,999
Members
448,541
Latest member
iparraguirre89

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