I cannot get Userform to auto populate a number for each entry

Stephenjames28 · Jan 13, 2014

Hope I can get some help here!....I have created a Userform and I want to create a unique reference for each form when they open the form and when they click OK it puts the reference number in the cell. The currect VB coding I have at present is the following:

Code:

Private Sub cmdOK_Click()
            Dim RowCount As Long
            Dim ctl As Control

            If Me.txtcustomer.Value = "" Then
               MsgBox "Please enter a Customer Name.", vbExclamation, "Hellmann Issue log"
               Me.txtcustomer.SetFocus
               Exit Sub
            End If
         
            If Me.txtcoordinator.Value = "" Then
               MsgBox "Please enter a Coordinator's Name.", vbExclamation, "Hellmann Issue log"
               Me.txtcoordinator.SetFocus
               Exit Sub
            End If

            If Not IsDate(Me.txtdate.Value) Then
               MsgBox "The Date box must contain a date.", vbExclamation, "Hellmann Issue log"
               Me.txtdate.SetFocus
               Exit Sub
            End If

            If Me.txtissue.Value = "" Then
               MsgBox "Please enter the issue", vbExclamation, "Hellmann Issue log"
               Me.txtissue.SetFocus
               Exit Sub
            End If

            If Me.txtconsequence.Value = "" Then
               MsgBox "Please enter consequence", vbExclamation, "Hellmann Issue log"
               Me.txtconsequence.SetFocus
               Exit Sub
            End If
            If Me.cboimpact.Value = "" Then
               MsgBox "Please select an impact value", vbExclamation, "Hellmann Issue log"
               Me.cboimpact.SetFocus
               Exit Sub
            End If

            If Me.txtrootcause.Value = "" Then
               MsgBox "Please type the root cause issue", vbExclamation, "Hellmann Issue log"
               Me.txtrootcause.SetFocus
               Exit Sub
            End If

            If Me.cbostatus.Value = "" Then
               MsgBox "Please select a status", vbExclamation, "Hellmann Issue log"
               Me.cbostatus.SetFocus
               Exit Sub
            End If

            RowCount = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
            With Worksheets("Sheet1").Range("A1")
            .Offset(RowCount, 0).Value = Me.txtcustomer.Value
            .Offset(RowCount, 1).Value = Me.txtcoordinator.Value
            .Offset(RowCount, 2).Value = DateValue(Me.txtdate.Value)
            .Offset(RowCount, 3).Value = Me.txtschoellerreference.Value
            .Offset(RowCount, 4).Value = Me.txtissue.Value
            .Offset(RowCount, 5).Value = Me.txtconsequence.Value
            .Offset(RowCount, 6).Value = Me.cboimpact.Value
            .Offset(RowCount, 7).Value = Me.txtrootcause.Value
            .Offset(RowCount, 8).Value = Me.txtactionagreed.Value
            .Offset(RowCount, 9).Value = Me.cbostatus.Value
            .Offset(RowCount, 10).Value = Format(Now, "dd/mm/yyyy hh:nn:ss")
            End With

            For Each ctl In Me.Controls
            If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
            ctl.Value = ""
            ElseIf TypeName(ctl) = "CheckBox" Then
            ctl.Value = False
            End If
            Next ctl
End Sub

Can you help??

Steve

crouchsw · Jan 13, 2014

Seems like it would work as is. From what you've written, you want to add some sort of control number to the form? Can it just be a sequential number? If so, just use the rowcount as your control number, and use the format command in VBA to pad it to 5 characters:

Code:

Private Sub cmdOK_Click()
Dim RowCount As Long
Dim ctl As Control
RowCount = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
userform1.hide
Me.labelcontrol.caption = format(rowcount,"00000") ' this would display the control number as 5 digits, with leading zeros
userform1.show
If Me.txtcustomer.Value = "" Then
MsgBox "Please enter a Customer Name.", vbExclamation, "Hellmann Issue log"
Me.txtcustomer.SetFocus
Exit Sub
End If
If Me.txtcoordinator.Value = "" Then
MsgBox "Please enter a Coordinator's Name.", vbExclamation, "Hellmann Issue log"
Me.txtcoordinator.SetFocus
Exit Sub
End If
If Not IsDate(Me.txtdate.Value) Then
MsgBox "The Date box must contain a date.", vbExclamation, "Hellmann Issue log"
Me.txtdate.SetFocus
Exit Sub
End If
If Me.txtissue.Value = "" Then
MsgBox "Please enter the issue", vbExclamation, "Hellmann Issue log"
Me.txtissue.SetFocus
Exit Sub
End If
If Me.txtconsequence.Value = "" Then
MsgBox "Please enter consequence", vbExclamation, "Hellmann Issue log"
Me.txtconsequence.SetFocus
Exit Sub
End If
If Me.cboimpact.Value = "" Then
MsgBox "Please select an impact value", vbExclamation, "Hellmann Issue log"
Me.cboimpact.SetFocus
Exit Sub
End If
If Me.txtrootcause.Value = "" Then
MsgBox "Please type the root cause issue", vbExclamation, "Hellmann Issue log"
Me.txtrootcause.SetFocus
Exit Sub
End If
If Me.cbostatus.Value = "" Then
MsgBox "Please select a status", vbExclamation, "Hellmann Issue log"
Me.cbostatus.SetFocus
Exit Sub
End If
With Worksheets("Sheet1").Range("A1")
.Offset(RowCount, 0).Value = Me.txtcustomer.Value
.Offset(RowCount, 1).Value = Me.txtcoordinator.Value
.Offset(RowCount, 2).Value = DateValue(Me.txtdate.Value)
.Offset(RowCount, 3).Value = Me.txtschoellerreference.Value
.Offset(RowCount, 4).Value = Me.txtissue.Value
.Offset(RowCount, 5).Value = Me.txtconsequence.Value
.Offset(RowCount, 6).Value = Me.cboimpact.Value
.Offset(RowCount, 7).Value = Me.txtrootcause.Value
.Offset(RowCount, 8).Value = Me.txtactionagreed.Value
.Offset(RowCount, 9).Value = Me.cbostatus.Value
.Offset(RowCount, 10).Value = Format(Now, "dd/mm/yyyy hh:nn:ss")
.Offset(rowcount, 11).Value = rowcount
End With
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
Exit Sub
End Sub

Stephenjames28 · Jan 14, 2014

Thankyou for your response it has been real help full. There is a little issue when I type the code in now it doesn't clear the boxes for the next user when the OK button is clicked?.

I have the following code now:

Private Sub cmdOK_Click()
Dim RowCount As Long
Dim ctl As Control
RowCount = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
UserForm1.Hide
Me.Label11.Caption = Format(RowCount, "00000")
UserForm1.Show
If Me.txtcustomer.Value = "" Then
MsgBox "Please enter a Customer Name.", vbExclamation, "Hellmann Issue log"
Me.txtcustomer.SetFocus
Exit Sub
End If
If Me.txtcoordinator.Value = "" Then
MsgBox "Please enter a Coordinator's Name.", vbExclamation, "Hellmann Issue log"
Me.txtcoordinator.SetFocus
Exit Sub
End If
If Not IsDate(Me.txtdate.Value) Then
MsgBox "The Date box must contain a date.", vbExclamation, "Hellmann Issue log"
Me.txtdate.SetFocus
Exit Sub
End If
If Me.txtissue.Value = "" Then
MsgBox "Please enter the issue", vbExclamation, "Hellmann Issue log"
Me.txtissue.SetFocus
Exit Sub
End If
If Me.txtconsequence.Value = "" Then
MsgBox "Please enter consequence", vbExclamation, "Hellmann Issue log"
Me.txtconsequence.SetFocus
Exit Sub
End If
If Me.cboimpact.Value = "" Then
MsgBox "Please select an impact value", vbExclamation, "Hellmann Issue log"
Me.cboimpact.SetFocus
Exit Sub
End If
If Me.txtrootcause.Value = "" Then
MsgBox "Please type the root cause issue", vbExclamation, "Hellmann Issue log"
Me.txtrootcause.SetFocus
Exit Sub
End If
If Me.cbostatus.Value = "" Then
MsgBox "Please select a status", vbExclamation, "Hellmann Issue log"
Me.cbostatus.SetFocus
Exit Sub
End If
With Worksheets("Sheet1").Range("A1")
.Offset(RowCount, 0).Value = Me.txtcustomer.Value
.Offset(RowCount, 1).Value = Me.txtcoordinator.Value
.Offset(RowCount, 2).Value = DateValue(Me.txtdate.Value)
.Offset(RowCount, 3).Value = Me.txtschoellerreference.Value
.Offset(RowCount, 4).Value = Me.txtissue.Value
.Offset(RowCount, 5).Value = Me.txtconsequence.Value
.Offset(RowCount, 6).Value = Me.cboimpact.Value
.Offset(RowCount, 7).Value = Me.txtrootcause.Value
.Offset(RowCount, 8).Value = Me.txtactionagreed.Value
.Offset(RowCount, 9).Value = Me.cbostatus.Value
.Offset(RowCount, 10).Value = Format(Now, "dd/mm/yyyy hh:nn:ss")
.Offset(RowCount, 11).Value = RowCount
End With
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
Exit Sub
End Sub

SirJB7 · Jan 14, 2014

Hi, Stephenjames28!

As a new user you might want (I'd say should and must) read this:
http://chandoo.org/forum/forums/new-users-please-start-here.14/

Besides, when posting code take care of the guideline suggested in the label over the ribbon of the reply text box area (at bottom of the screen, i.e., where you type the post content).

Regards!

crouchsw · Jan 14, 2014

Ok. Got it.
Add this to the code that originally shows your userform:

Code:

...
load userform1
...
rowcount=Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
Me.labelcontrol.caption = format(rowcount,"00000") ' this would display the control number as 5 digits, with leading zeros
...
userform1.show

And have this as the ok click code

Code:

Private Sub cmdOK_Click()
Dim RowCount As Long
Dim ctl As Control
RowCount = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
If Me.txtcustomer.Value = "" Then
MsgBox "Please enter a Customer Name.", vbExclamation, "Hellmann Issue log"
Me.txtcustomer.SetFocus
Exit Sub
End If
If Me.txtcoordinator.Value = "" Then
MsgBox "Please enter a Coordinator's Name.", vbExclamation, "Hellmann Issue log"
Me.txtcoordinator.SetFocus
Exit Sub
End If
If Not IsDate(Me.txtdate.Value) Then
MsgBox "The Date box must contain a date.", vbExclamation, "Hellmann Issue log"
Me.txtdate.SetFocus
Exit Sub
End If
If Me.txtissue.Value = "" Then
MsgBox "Please enter the issue", vbExclamation, "Hellmann Issue log"
Me.txtissue.SetFocus
Exit Sub
End If
If Me.txtconsequence.Value = "" Then
MsgBox "Please enter consequence", vbExclamation, "Hellmann Issue log"
Me.txtconsequence.SetFocus
Exit Sub
End If
If Me.cboimpact.Value = "" Then
MsgBox "Please select an impact value", vbExclamation, "Hellmann Issue log"
Me.cboimpact.SetFocus
Exit Sub
End If
If Me.txtrootcause.Value = "" Then
MsgBox "Please type the root cause issue", vbExclamation, "Hellmann Issue log"
Me.txtrootcause.SetFocus
Exit Sub
End If
If Me.cbostatus.Value = "" Then
MsgBox "Please select a status", vbExclamation, "Hellmann Issue log"
Me.cbostatus.SetFocus
Exit Sub
End If
With Worksheets("Sheet1").Range("A1")
.Offset(RowCount, 0).Value = Me.txtcustomer.Value
.Offset(RowCount, 1).Value = Me.txtcoordinator.Value
.Offset(RowCount, 2).Value = DateValue(Me.txtdate.Value)
.Offset(RowCount, 3).Value = Me.txtschoellerreference.Value
.Offset(RowCount, 4).Value = Me.txtissue.Value
.Offset(RowCount, 5).Value = Me.txtconsequence.Value
.Offset(RowCount, 6).Value = Me.cboimpact.Value
.Offset(RowCount, 7).Value = Me.txtrootcause.Value
.Offset(RowCount, 8).Value = Me.txtactionagreed.Value
.Offset(RowCount, 9).Value = Me.cbostatus.Value
.Offset(RowCount, 10).Value = Format(Now, "dd/mm/yyyy hh:nn:ss")
.Offset(rowcount, 11).Value = rowcount
End With
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
userform1.hide
unload userform1
rowcount=Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
load userform1
Me.labelcontrol.caption = format(rowcount,"00000") ' this would display the control number as 5 digits, with leading zeros
userform1.show

Exit Sub
End Sub

I cannot get Userform to auto populate a number for each entry

Stephenjames28

New Member

crouchsw

Member

Stephenjames28

New Member

SirJB7

Excel Rōnin

crouchsw

Member