Excel VBA Print Name Tag from Userform

Jaye Cavallo

New Member
Joined
Mar 10, 2022
Messages
41
Office Version
  1. 2016
Platform
  1. Windows
Hello,

I have created an Excel userform for an attendee to check in at an event. The userform collects first name, last name, email, mobile, etc. Then the user clicks the save button and the data is transferred to the Excel worksheet and creates a unique ID for each row of data. Keep in mind, the data is entered one at a time as the attendees check in. Therefore, every time an attendee checks in by entering their data, a new row and unique ID are created on the worksheet.

I am wondering if there is a way to print a name tag from the userform, so the attendee would click the button to save their information an print a name tag with at least first name, last name and unique id number on the name tag. The printer is a Zebra name tag printer.

Private Sub cmdSavePrint_Click()

'Validation
If Me.TextBox1.value = "" Then
MsgBox "Please enter your first name" ', vbCritical
Me.TextBox1.SetFocus
Exit Sub
End If

If Me.TextBox2.value = "" Then
MsgBox "Please enter your last name" ', vbCritical
Me.TextBox2.SetFocus
Exit Sub
End If

'Validation.
If Me.TextBox3.value = "" Then
MsgBox "Please enter a valid e-mail address" ', vbCritical
Me.TextBox3.SetFocus
Exit Sub
End If

Dim emptyRow As Long

'Make Sheet1 active
Worksheets("Registration").Activate

'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

'Transfer information

If IsValidEmail(TextBox3) Then
'Transfer information
Cells(emptyRow, 1).value = TextBox1.value
Cells(emptyRow, 2).value = TextBox2.value
Cells(emptyRow, 3).value = TextBox3.value
Cells(emptyRow, 4).value = TextBox4.value
Cells(emptyRow, 5).value = TextBox5.value
Cells(emptyRow, 6).value = TextBox6.value
Cells(emptyRow, 7).value = TextBox7.value
Cells(emptyRow, 8).value = TextBox8.value
Cells(emptyRow, 9).value = TextBox9.value
Cells(emptyRow, 10).value = TextBox10.value

If obUpdatesYes.value = True Then
Cells(emptyRow, 11).value = "Yes"
ElseIf obUpdatesNo.value = True Then
Cells(emptyRow, 11).value = "No"
End If

vbclearResponse = MsgBox("Are you sure you print a name tag?", vbYesNoCancel + vbQuestion, "Print Name Tag and Clear Cell Contents")
If vbclearResponse = vbYes Then
Me.TextBox1.value = ""
Me.TextBox2.value = ""
Me.TextBox3.value = ""
Me.TextBox4.value = ""
Me.TextBox5.value = ""
Me.TextBox6.value = ""
Me.TextBox7.value = ""
Me.TextBox8.value = ""
Me.TextBox9.value = ""
Me.TextBox10.value = ""

ElseIf vbclearResponse = vbNo Then
'Code here if user clicked no
End If
Else
MsgBox "Please enter a valid email address." ', vbCritical
Me.TextBox3.SetFocus
End If

With Cells(emptyRow, "L")
.value = Left(.Offset(-1), 1) & Format(Mid(.Offset(-1), 2) + 1, "000000")
End With

End Sub


Private Sub frmInformation_Click()

End Sub

Private Sub UserForm_Initialize()

Worksheets("Registration").Activate

Dim ws As Worksheet
Set ws = Worksheets("Registration")

Me.TextBox1.SetFocus

End Sub

Private Sub CommandButton1_Click()

Worksheets("Registration").Activate
Dim firstname As String
Dim lastname As String

firstname = TextBox1.value
lastname = TextBox2.value

End Sub

Private Sub TextBox9_Exit(ByVal Cancel As MSForms.ReturnBoolean)

Me.TextBox9.Text = Format(TextBox9.Text, "000-000-0000")

End Sub

Private Sub TextBox10_Exit(ByVal Cancel As MSForms.ReturnBoolean)

Me.TextBox10.Text = Format(TextBox10.Text, "000-000-0000")

End Sub

Private Function IsValidEmail(value As String) As Boolean

Dim RE As Object
Set RE = CreateObject("vbscript.RegExp")
RE.Pattern = "^[a-zA-Z0-9\._-]+@([a-zA-Z0-9_-]+\.)+([a-zA-Z]{2,3})$"
IsValidEmail = RE.Test(value)
Set RE = Nothing

End Function
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Please format your code using the VBA button in this editor or read my signature
VBA Code:
Private Sub cmdSavePrint_Click()

'Validation
If Me.TextBox1.value = "" Then
   MsgBox "Please enter your first name" ', vbCritical
   Me.TextBox1.SetFocus
 Exit Sub
End If

If Me.TextBox2.value = "" Then
   MsgBox "Please enter your last name" ', vbCritical
   Me.TextBox2.SetFocus
 Exit Sub
End If

'Validation.
If Me.TextBox3.value = "" Then
   MsgBox "Please enter a valid e-mail address" ', vbCritical
   Me.TextBox3.SetFocus
 Exit Sub
End If

Dim emptyRow As Long
 
  'Make Sheet1 active
  Worksheets("Registration").Activate
 
  'Determine emptyRow
  emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
 
  'Transfer information
  
If IsValidEmail(TextBox3) Then
  'Transfer information
  Cells(emptyRow, 1).value = TextBox1.value
  Cells(emptyRow, 2).value = TextBox2.value
  Cells(emptyRow, 3).value = TextBox3.value
  Cells(emptyRow, 4).value = TextBox4.value
  Cells(emptyRow, 5).value = TextBox5.value
  Cells(emptyRow, 6).value = TextBox6.value
  Cells(emptyRow, 7).value = TextBox7.value
  Cells(emptyRow, 8).value = TextBox8.value
  Cells(emptyRow, 9).value = TextBox9.value
  Cells(emptyRow, 10).value = TextBox10.value
  
  If obUpdatesYes.value = True Then
      Cells(emptyRow, 11).value = "Yes"
  ElseIf obUpdatesNo.value = True Then
       Cells(emptyRow, 11).value = "No"
  End If
  
   vbclearResponse = MsgBox("Are you sure you print a name tag?", vbYesNoCancel + vbQuestion, "Print Name Tag and Clear Cell Contents")
   If vbclearResponse = vbYes Then
       Me.TextBox1.value = ""
       Me.TextBox2.value = ""
       Me.TextBox3.value = ""
       Me.TextBox4.value = ""
       Me.TextBox5.value = ""
       Me.TextBox6.value = ""
       Me.TextBox7.value = ""
       Me.TextBox8.value = ""
       Me.TextBox9.value = ""
       Me.TextBox10.value = ""
   
   ElseIf vbclearResponse = vbNo Then
       'Code here if user clicked no
       End If
Else
   MsgBox "Please enter a valid email address." ', vbCritical
   Me.TextBox3.SetFocus
End If

With Cells(emptyRow, "L")
   .value = Left(.Offset(-1), 1) & Format(Mid(.Offset(-1), 2) + 1, "000000")
End With

End Sub


Private Sub frmInformation_Click()

End Sub

Private Sub UserForm_Initialize()

Worksheets("Registration").Activate

Dim ws As Worksheet
Set ws = Worksheets("Registration")

Me.TextBox1.SetFocus

End Sub

Private Sub CommandButton1_Click()

Worksheets("Registration").Activate
Dim firstname As String
Dim lastname As String

firstname = TextBox1.value
lastname = TextBox2.value

End Sub

Private Sub TextBox9_Exit(ByVal Cancel As MSForms.ReturnBoolean)

Me.TextBox9.Text = Format(TextBox9.Text, "000-000-0000")

End Sub

Private Sub TextBox10_Exit(ByVal Cancel As MSForms.ReturnBoolean)

Me.TextBox10.Text = Format(TextBox10.Text, "000-000-0000")

End Sub

Private Function IsValidEmail(value As String) As Boolean

Dim RE As Object
Set RE = CreateObject("vbscript.RegExp")
RE.Pattern = "^[a-zA-Z0-9\._-]+@([a-zA-Z0-9_-]+\.)+([a-zA-Z]{2,3})$"
IsValidEmail = RE.Test(value)
Set RE = Nothing

End Function
 
Upvote 0
Hello,

I have created an Excel userform for an attendee to check in at an event. The userform collects first name, last name, email, mobile, etc. Then the user clicks the save button and the data is transferred to the Excel worksheet and creates a unique ID for each row of data. Keep in mind, the data is entered one at a time as the attendees check in. Therefore, every time an attendee checks in by entering their data, a new row and unique ID are created on the worksheet.

I am wondering if there is a way to print a name tag from the userform, so the attendee would click the button to save their information an print a name tag with at least first name, last name and unique id number on the name tag. The printer is a Zebra name tag printer.
Yes, it is possible.
As each attendee enters their data, get the code to craete a new sheet and enter the data directly into it then print that sheet and delete it. It is a once-off way to get the tag printed and no reprints for security.

Capture their data in an array and use the array to store their data in the attendee list and on the temporary worksheet. asi data will remain in the array you could have a reprint option for last attendee in case of printer errors etc.
 
Upvote 0

Forum statistics

Threads
1,217,993
Messages
6,139,841
Members
450,242
Latest member
mikey18

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