Auto Number with VBA

E

excelenergy

Board Regular
Joined
Jun 7, 2012
Messages
142
Hello,

I have a userform (I provided the code that controls the userform below). What I essintially want to happen, is the userform inputs its data into the excel sheet. Right now there is a field in the userform to type in the ID of the entry. I would like Excel to automatically number these (Ie: Check to see if there is an entry 1, if not, Excel automatically assigns 001 to the entry, then, when the next user makes an entry, excel will automatically number 002 and so on and so fourth.

I tried doing the auto numbering myself, but couldn't get it to work, does anyone know how to do this? Thanksss

Code: 
Option Explicit
Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet

Set ws = Worksheets("View Lessons")
'''find  first empty row in database
''iRow = ws.Cells(Rows.Count, 1) _
''  .End(xlUp).Offset(1, 0).Row
'revised code to avoid problems with Excel tables in newer versions
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a part number

If Trim(Me.txtPart.Value) = "" Then
  Me.txtPart.SetFocus
  MsgBox "Please enter a part number"
  Exit Sub
End If

'copy the data to the database
ws.Cells(iRow, 1).Value = Me.txtPart.Value
ws.Cells(iRow, 2).Value = Me.txtLoc.Value
ws.Cells(iRow, 3).Value = Me.txtDate.Value
ws.Cells(iRow, 4).Value = Me.txtQty.Value

ws.Cells(iRow, 5).Value = Me.txtSdate.Value
ws.Cells(iRow, 6).Value = Me.txtldescription.Value
ws.Cells(iRow, 7).Value = Me.txtcauselesson.Value
ws.Cells(iRow, 8).Value = Me.txtlearned.Value

ws.Cells(iRow, 9).Value = Me.txtfirst.Value
ws.Cells(iRow, 10).Value = Me.txtlast.Value
ws.Cells(iRow, 11).Value = Me.txtemail.Value
ws.Cells(iRow, 12).Value = Me.txtphone.Value
ws.Cells(iRow, 13).Value = Me.txtBU.Value
ws.Cells(iRow, 14).Value = Me.txtBCat.Value
ws.Cells(iRow, 15).Value = Me.txtBSub.Value
ws.Cells(iRow, 16).Value = Me.txtlocation.Value
ws.Cells(iRow, 17).Value = Me.txtrisk.Value
ws.Cells(iRow, 18).Value = Me.txtattach.Value
ws.Cells(iRow, 19).Value = Me.txtophase.Value
ws.Cells(iRow, 20).Value = Me.txtphase.Value
ws.Cells(iRow, 21).Value = Me.txtaddition.Value
ws.Cells(iRow, 22).Value = Me.txtlessons.Value
ws.Cells(iRow, 23).Value = Me.txtabc.Value
ws.Cells(iRow, 24).Value = Me.txtkeywords.Value
'clear the data
Me.txtPart.Value = ""
Me.txtLoc.Value = ""
Me.txtDate.Value = ""
Me.txtQty.Value = ""
Me.txtSdate.Value = ""
Me.txtldescription.Value = ""
Me.txtcauselesson.Value = ""
Me.txtlearned.Value = ""
Me.txtfirst.Value = ""
Me.txtlast.Value = ""
Me.txtemail.Value = ""
Me.txtphone.Value = ""
Me.txtBU.Value = ""
Me.txtBCat.Value = ""
Me.txtBSub.Value = ""
Me.txtlocation.Value = ""
Me.txtrisk.Value = ""
Me.txtattach.Value = ""
Me.txtophase.Value = ""
Me.txtphase.Value = ""
Me.txtaddition.Value = ""
Me.txtlessons.Value = ""
Me.txtabc.Value = ""
Me.txtkeywords.Value = ""
Me.txtPart.SetFocus
End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Sort by date Sort by votes
Play around with the likes of:
Code: 
WS.Cells(iRow, 1).Value = Application.Max(Range("A:A")) + 1
WS.Cells(iRow, 1).NumberFormat = "000"
and do away with txtPart...,
or perhaps load txtPart with the likes of:
Code: 
txtPart.Value = Format(Application.Max(WS.Range("A:A")) + 1, "000")
instead of ""
 
Upvote 0
Hey there,

Thanks for the response. Unfortunately it didn't work. If you try to make a submission without putting in the ID number it says, "please enter id number".

But let me ask this...Do I need to remove the ID field now that I have this auto number thing going? Or can the field remain on the userform? What I thought would sort of happen is the ID field would populate itself, and the text box be un-editable to the user. Dont worry about the field properties, I can edit the textbox properties so that users cant change the number Excel puts in. But how can I get this to pre-populate the ID number........hmmm thanks in advance, here is the new code:

Code: 
Option Explicit
Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("View Lessons")
'''find  first empty row in database
''iRow = ws.Cells(Rows.Count, 1) _
''  .End(xlUp).Offset(1, 0).Row
'revised code to avoid problems with Excel tables in newer versions
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a part number
If Trim(Me.txtPart.Value) = "" Then
  Me.txtPart.SetFocus
  MsgBox "Please enter a part number"
  Exit Sub
End If
'copy the data to the database
ws.Cells(iRow, 1).Value = Application.Max(Range("A:A")) + 1
ws.Cells(iRow, 1).NumberFormat = "000"
ws.Cells(iRow, 2).Value = Me.txtLoc.Value
ws.Cells(iRow, 3).Value = Me.txtDate.Value
ws.Cells(iRow, 4).Value = Me.txtQty.Value

ws.Cells(iRow, 5).Value = Me.txtSdate.Value
ws.Cells(iRow, 6).Value = Me.txtldescription.Value
ws.Cells(iRow, 7).Value = Me.txtcauselesson.Value
ws.Cells(iRow, 8).Value = Me.txtlearned.Value

ws.Cells(iRow, 9).Value = Me.txtfirst.Value
ws.Cells(iRow, 10).Value = Me.txtlast.Value
ws.Cells(iRow, 11).Value = Me.txtemail.Value
ws.Cells(iRow, 12).Value = Me.txtphone.Value
ws.Cells(iRow, 13).Value = Me.ComboBox2.Value
ws.Cells(iRow, 14).Value = Me.txtBCat.Value
ws.Cells(iRow, 15).Value = Me.txtBSub.Value
ws.Cells(iRow, 16).Value = Me.ComboBox1.Value
ws.Cells(iRow, 17).Value = Me.txtrisk.Value
ws.Cells(iRow, 18).Value = Me.txtattach.Value
ws.Cells(iRow, 19).Value = Me.txtophase.Value
ws.Cells(iRow, 20).Value = Me.txtphase.Value
ws.Cells(iRow, 21).Value = Me.txtaddition.Value
ws.Cells(iRow, 22).Value = Me.txtlessons.Value
ws.Cells(iRow, 23).Value = Me.txtabc.Value
ws.Cells(iRow, 24).Value = Me.txtkeywords.Value
'clear the data
Me.txtPart.Value = Format(Application.Max(ws.Range("A:A")) + 1, "000")
Me.txtLoc.Value = ""
Me.txtDate.Value = ""
Me.txtQty.Value = ""
Me.txtSdate.Value = ""
Me.txtldescription.Value = ""
Me.txtcauselesson.Value = ""
Me.txtlearned.Value = ""
Me.txtfirst.Value = ""
Me.txtlast.Value = ""
Me.txtemail.Value = ""
Me.txtphone.Value = ""
Me.ComboBox2.Value = ""
Me.txtBCat.Value = ""
Me.txtBSub.Value = ""
Me.ComboBox1.Value = ""
Me.txtrisk.Value = ""
Me.txtattach.Value = ""
Me.txtophase.Value = ""
Me.txtphase.Value = ""
Me.txtaddition.Value = ""
Me.txtlessons.Value = ""
Me.txtabc.Value = ""
Me.txtkeywords.Value = ""
Me.txtPart.SetFocus
End Sub

p45cal said:
Play around with the likes of:
Code: 
WS.Cells(iRow, 1).Value = Application.Max(Range("A:A")) + 1
WS.Cells(iRow, 1).NumberFormat = "000"
and do away with txtPart...,
or perhaps load txtPart with the likes of:
Code: 
txtPart.Value = Format(Application.Max(WS.Range("A:A")) + 1, "000")
instead of ""
Click to expand...
 
Upvote 0
excelenergy said:
Hello,

I have a userform (I provided the code that controls the userform below). What I essintially want to happen, is the userform inputs its data into the excel sheet. Right now there is a field in the userform to type in the ID of the entry. I would like Excel to automatically number these (Ie: Check to see if there is an entry 1, if not, Excel automatically assigns 001 to the entry, then, when the next user makes an entry, excel will automatically number 002 and so on and so fourth.

I tried doing the auto numbering myself, but couldn't get it to work, does anyone know how to do this? Thanksss

Code: 
Option Explicit
Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet

Set ws = Worksheets("View Lessons")
'''find  first empty row in database
''iRow = ws.Cells(Rows.Count, 1) _
''  .End(xlUp).Offset(1, 0).Row
'revised code to avoid problems with Excel tables in newer versions
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a part number

If Trim(Me.txtPart.Value) = "" Then
  Me.txtPart.SetFocus
  MsgBox "Please enter a part number"
  Exit Sub
End If

'copy the data to the database
ws.Cells(iRow, 1).Value = Me.txtPart.Value
ws.Cells(iRow, 2).Value = Me.txtLoc.Value
ws.Cells(iRow, 3).Value = Me.txtDate.Value
ws.Cells(iRow, 4).Value = Me.txtQty.Value

ws.Cells(iRow, 5).Value = Me.txtSdate.Value
ws.Cells(iRow, 6).Value = Me.txtldescription.Value
ws.Cells(iRow, 7).Value = Me.txtcauselesson.Value
ws.Cells(iRow, 8).Value = Me.txtlearned.Value

ws.Cells(iRow, 9).Value = Me.txtfirst.Value
ws.Cells(iRow, 10).Value = Me.txtlast.Value
ws.Cells(iRow, 11).Value = Me.txtemail.Value
ws.Cells(iRow, 12).Value = Me.txtphone.Value
ws.Cells(iRow, 13).Value = Me.txtBU.Value
ws.Cells(iRow, 14).Value = Me.txtBCat.Value
ws.Cells(iRow, 15).Value = Me.txtBSub.Value
ws.Cells(iRow, 16).Value = Me.txtlocation.Value
ws.Cells(iRow, 17).Value = Me.txtrisk.Value
ws.Cells(iRow, 18).Value = Me.txtattach.Value
ws.Cells(iRow, 19).Value = Me.txtophase.Value
ws.Cells(iRow, 20).Value = Me.txtphase.Value
ws.Cells(iRow, 21).Value = Me.txtaddition.Value
ws.Cells(iRow, 22).Value = Me.txtlessons.Value
ws.Cells(iRow, 23).Value = Me.txtabc.Value
ws.Cells(iRow, 24).Value = Me.txtkeywords.Value
'clear the data
Me.txtPart.Value = ""
Me.txtLoc.Value = ""
Me.txtDate.Value = ""
Me.txtQty.Value = ""
Me.txtSdate.Value = ""
Me.txtldescription.Value = ""
Me.txtcauselesson.Value = ""
Me.txtlearned.Value = ""
Me.txtfirst.Value = ""
Me.txtlast.Value = ""
Me.txtemail.Value = ""
Me.txtphone.Value = ""
Me.txtBU.Value = ""
Me.txtBCat.Value = ""
Me.txtBSub.Value = ""
Me.txtlocation.Value = ""
Me.txtrisk.Value = ""
Me.txtattach.Value = ""
Me.txtophase.Value = ""
Me.txtphase.Value = ""
Me.txtaddition.Value = ""
Me.txtlessons.Value = ""
Me.txtabc.Value = ""
Me.txtkeywords.Value = ""
Me.txtPart.SetFocus
End Sub
Click to expand...
is this the whole code? where's the code that automate the id number?
 
Upvote 0
Try this one
Code: 
Option Explicit
Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
dim idnum as integer
Set ws = Worksheets("View Lessons")
'''find  first empty row in database
''iRow = ws.Cells(Rows.Count, 1) _
''  .End(xlUp).Offset(1, 0).Row
'revised code to avoid problems with Excel tables in newer versions
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a part number


If Trim(Me.txtPart.Value) = "" Then
     if isnumeric(ws.cells(irow-1,1).value) = True then
         idnum = ws.cells(irow-1,1).value + 1
         ws.cells(irow,1).value = format(idnum,"000") 
    else 
         idnum = 1
         ws.cells(irow,1).value = format(idnum,"000")
    endif
else
     ws.Cells(iRow, 1).Value = Me.txtPart.Value
endif
'copy the data to the database
ws.Cells(iRow, 2).Value = Me.txtLoc.Value
ws.Cells(iRow, 3).Value = Me.txtDate.Value
ws.Cells(iRow, 4).Value = Me.txtQty.Value


ws.Cells(iRow, 5).Value = Me.txtSdate.Value
ws.Cells(iRow, 6).Value = Me.txtldescription.Value
ws.Cells(iRow, 7).Value = Me.txtcauselesson.Value
ws.Cells(iRow, 8).Value = Me.txtlearned.Value


ws.Cells(iRow, 9).Value = Me.txtfirst.Value
ws.Cells(iRow, 10).Value = Me.txtlast.Value
ws.Cells(iRow, 11).Value = Me.txtemail.Value
ws.Cells(iRow, 12).Value = Me.txtphone.Value
ws.Cells(iRow, 13).Value = Me.txtBU.Value
ws.Cells(iRow, 14).Value = Me.txtBCat.Value
ws.Cells(iRow, 15).Value = Me.txtBSub.Value
ws.Cells(iRow, 16).Value = Me.txtlocation.Value
ws.Cells(iRow, 17).Value = Me.txtrisk.Value
ws.Cells(iRow, 18).Value = Me.txtattach.Value
ws.Cells(iRow, 19).Value = Me.txtophase.Value
ws.Cells(iRow, 20).Value = Me.txtphase.Value
ws.Cells(iRow, 21).Value = Me.txtaddition.Value
ws.Cells(iRow, 22).Value = Me.txtlessons.Value
ws.Cells(iRow, 23).Value = Me.txtabc.Value
ws.Cells(iRow, 24).Value = Me.txtkeywords.Value
'clear the data
Me.txtPart.Value = ""
Me.txtLoc.Value = ""
Me.txtDate.Value = ""
Me.txtQty.Value = ""
Me.txtSdate.Value = ""
Me.txtldescription.Value = ""
Me.txtcauselesson.Value = ""
Me.txtlearned.Value = ""
Me.txtfirst.Value = ""
Me.txtlast.Value = ""
Me.txtemail.Value = ""
Me.txtphone.Value = ""
Me.txtBU.Value = ""
Me.txtBCat.Value = ""
Me.txtBSub.Value = ""
Me.txtlocation.Value = ""
Me.txtrisk.Value = ""
Me.txtattach.Value = ""
Me.txtophase.Value = ""
Me.txtphase.Value = ""
Me.txtaddition.Value = ""
Me.txtlessons.Value = ""
Me.txtabc.Value = ""
Me.txtkeywords.Value = ""
Me.txtPart.SetFocus
End Sub
 
Upvote 0
If you're going to want to enter several rows of data with a single showing of the user form then you can change the:

Me.txtPart.Value = ""
in your/lancerj017's code to:
txtPart.Value = Format(Application.Max(WS.Range("A:A")) + 1, "000")
and it might be better to change the:
Me.txtPart.SetFocus
to:
txtLoc.SetFocus
or some such, so that the user doesn't accidentally change the value (but he isn't prevented from doing so).
 
Upvote 0
Hey Guys,

Alright, I made those changes, but let me give you an example of what happens:
1. Form opens, for the user to fill out
2. User fills out information, except for the ID > hits submit.

Since there was nothing in the ID field, the form says, "Enter ID number"
....The ID field still isn't populating for some reason :(

Revised code
Code: 
Option Explicit
Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("View Lessons")
'''find  first empty row in database
''iRow = ws.Cells(Rows.Count, 1) _
''  .End(xlUp).Offset(1, 0).Row
'revised code to avoid problems with Excel tables in newer versions
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a part number
If Trim(Me.txtPart.Value) = "" Then
  Me.txtPart.SetFocus
  MsgBox "Please enter an ID Number"
  Exit Sub
End If
'copy the data to the database

ws.Cells(iRow, 1).Value = Application.Max(Range("A:A")) + 1
ws.Cells(iRow, 1).NumberFormat = "000"
ws.Cells(iRow, 2).Value = Me.txtLoc.Value
ws.Cells(iRow, 3).Value = Me.txtDate.Value
ws.Cells(iRow, 4).Value = Me.txtQty.Value

ws.Cells(iRow, 5).Value = Me.txtSdate.Value
ws.Cells(iRow, 6).Value = Me.txtldescription.Value
ws.Cells(iRow, 7).Value = Me.txtcauselesson.Value
ws.Cells(iRow, 8).Value = Me.txtlearned.Value

ws.Cells(iRow, 9).Value = Me.txtfirst.Value
ws.Cells(iRow, 10).Value = Me.txtlast.Value
ws.Cells(iRow, 11).Value = Me.txtemail.Value
ws.Cells(iRow, 12).Value = Me.txtphone.Value
ws.Cells(iRow, 13).Value = Me.ComboBox2.Value
ws.Cells(iRow, 14).Value = Me.txtBCat.Value
ws.Cells(iRow, 15).Value = Me.txtBSub.Value
ws.Cells(iRow, 16).Value = Me.ComboBox1.Value
ws.Cells(iRow, 17).Value = Me.txtrisk.Value
ws.Cells(iRow, 18).Value = Me.txtattach.Value
ws.Cells(iRow, 19).Value = Me.txtophase.Value
ws.Cells(iRow, 20).Value = Me.txtphase.Value
ws.Cells(iRow, 21).Value = Me.txtaddition.Value
ws.Cells(iRow, 22).Value = Me.txtlessons.Value
ws.Cells(iRow, 23).Value = Me.txtabc.Value
ws.Cells(iRow, 24).Value = Me.txtkeywords.Value
'clear the data
Me.txtPart.Value = Format(Application.Max(ws.Range("A:A")) + 1, "000")
Me.txtLoc.Value = ""
Me.txtDate.Value = ""
Me.txtQty.Value = ""
Me.txtSdate.Value = ""
Me.txtldescription.Value = ""
Me.txtcauselesson.Value = ""
Me.txtlearned.Value = ""
Me.txtfirst.Value = ""
Me.txtlast.Value = ""
Me.txtemail.Value = ""
Me.txtphone.Value = ""
Me.ComboBox2.Value = ""
Me.txtBCat.Value = ""
Me.txtBSub.Value = ""
Me.ComboBox1.Value = ""
Me.txtrisk.Value = ""
Me.txtattach.Value = ""
Me.txtophase.Value = ""
Me.txtphase.Value = ""
Me.txtaddition.Value = ""
Me.txtlessons.Value = ""
Me.txtabc.Value = ""
Me.txtkeywords.Value = ""
Me.txtLoc.SetFocus
End Sub

p45cal said:
If you're going to want to enter several rows of data with a single showing of the user form then you can change the:

Me.txtPart.Value = ""
in your/lancerj017's code to:
txtPart.Value = Format(Application.Max(WS.Range("A:A")) + 1, "000")
and it might be better to change the:
Me.txtPart.SetFocus
to:
txtLoc.SetFocus
or some such, so that the user doesn't accidentally change the value (but he isn't prevented from doing so).
Click to expand...
 
Upvote 0
Try the following. At the bottom there is a sub called UserForm_Initialize. If you already have one of these then just add its single line to the end of the existing one.
Code: 
Option Explicit
Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("View Lessons")
'''find  first empty row in database
''iRow = ws.Cells(Rows.Count, 1) .End(xlUp).Offset(1, 0).Row
'revised code to avoid problems with Excel tables in newer versions
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a part number
If Trim(Me.txtPart.Value) = "" Then
  Me.txtPart.SetFocus
  MsgBox "Please enter an ID Number; one will be suggested…"
  txtPart.Value = Format(Application.Max(ws.Range("A:A")) + 1, "000")
  Exit Sub
End If
'copy the data to the database
ws.Cells(iRow, 1).Value = txtPart.Value
ws.Cells(iRow, 1).NumberFormat = "000"
ws.Cells(iRow, 2).Value = Me.txtLoc.Value
ws.Cells(iRow, 3).Value = Me.txtDate.Value
ws.Cells(iRow, 4).Value = Me.txtQty.Value

ws.Cells(iRow, 5).Value = Me.txtSdate.Value
ws.Cells(iRow, 6).Value = Me.txtldescription.Value
ws.Cells(iRow, 7).Value = Me.txtcauselesson.Value
ws.Cells(iRow, 8).Value = Me.txtlearned.Value

ws.Cells(iRow, 9).Value = Me.txtfirst.Value
ws.Cells(iRow, 10).Value = Me.txtlast.Value
ws.Cells(iRow, 11).Value = Me.txtemail.Value
ws.Cells(iRow, 12).Value = Me.txtphone.Value
ws.Cells(iRow, 13).Value = Me.ComboBox2.Value
ws.Cells(iRow, 14).Value = Me.txtBCat.Value
ws.Cells(iRow, 15).Value = Me.txtBSub.Value
ws.Cells(iRow, 16).Value = Me.ComboBox1.Value
ws.Cells(iRow, 17).Value = Me.txtrisk.Value
ws.Cells(iRow, 18).Value = Me.txtattach.Value
ws.Cells(iRow, 19).Value = Me.txtophase.Value
ws.Cells(iRow, 20).Value = Me.txtphase.Value
ws.Cells(iRow, 21).Value = Me.txtaddition.Value
ws.Cells(iRow, 22).Value = Me.txtlessons.Value
ws.Cells(iRow, 23).Value = Me.txtabc.Value
ws.Cells(iRow, 24).Value = Me.txtkeywords.Value
'clear the data
txtPart.Value = Format(Application.Max(ws.Range("A:A")) + 1, "000")
Me.txtLoc.Value = ""
Me.txtDate.Value = ""
Me.txtQty.Value = ""
Me.txtSdate.Value = ""
Me.txtldescription.Value = ""
Me.txtcauselesson.Value = ""
Me.txtlearned.Value = ""
Me.txtfirst.Value = ""
Me.txtlast.Value = ""
Me.txtemail.Value = ""
Me.txtphone.Value = ""
Me.ComboBox2.Value = ""
Me.txtBCat.Value = ""
Me.txtBSub.Value = ""
Me.ComboBox1.Value = ""
Me.txtrisk.Value = ""
Me.txtattach.Value = ""
Me.txtophase.Value = ""
Me.txtphase.Value = ""
Me.txtaddition.Value = ""
Me.txtlessons.Value = ""
Me.txtabc.Value = ""
Me.txtkeywords.Value = ""
Me.txtLoc.SetFocus
End Sub

Private Sub UserForm_Initialize()
txtPart.Value = Format(Application.Max(Sheets("View Lessons").Range("A:A")) + 1, "000")
End Sub
 
Upvote 0
Hey there!

Thanks a million!! It finally worked! While we are on the topic though, as much as I hate to ask this, do you see where it says:
txtSdate

that represents a textbox for the users to insert todays' day, or whatever the current days date is....Is there a way to make that autopopulate as well with whatever the current date is?



p45cal said:
Try the following. At the bottom there is a sub called UserForm_Initialize. If you already have one of these then just add its single line to the end of the existing one.
Code: 
Option Explicit
Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("View Lessons")
'''find  first empty row in database
''iRow = ws.Cells(Rows.Count, 1) .End(xlUp).Offset(1, 0).Row
'revised code to avoid problems with Excel tables in newer versions
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a part number
If Trim(Me.txtPart.Value) = "" Then
  Me.txtPart.SetFocus
  MsgBox "Please enter an ID Number; one will be suggested…"
  txtPart.Value = Format(Application.Max(ws.Range("A:A")) + 1, "000")
  Exit Sub
End If
'copy the data to the database
ws.Cells(iRow, 1).Value = txtPart.Value
ws.Cells(iRow, 1).NumberFormat = "000"
ws.Cells(iRow, 2).Value = Me.txtLoc.Value
ws.Cells(iRow, 3).Value = Me.txtDate.Value
ws.Cells(iRow, 4).Value = Me.txtQty.Value

ws.Cells(iRow, 5).Value = Me.txtSdate.Value
ws.Cells(iRow, 6).Value = Me.txtldescription.Value
ws.Cells(iRow, 7).Value = Me.txtcauselesson.Value
ws.Cells(iRow, 8).Value = Me.txtlearned.Value

ws.Cells(iRow, 9).Value = Me.txtfirst.Value
ws.Cells(iRow, 10).Value = Me.txtlast.Value
ws.Cells(iRow, 11).Value = Me.txtemail.Value
ws.Cells(iRow, 12).Value = Me.txtphone.Value
ws.Cells(iRow, 13).Value = Me.ComboBox2.Value
ws.Cells(iRow, 14).Value = Me.txtBCat.Value
ws.Cells(iRow, 15).Value = Me.txtBSub.Value
ws.Cells(iRow, 16).Value = Me.ComboBox1.Value
ws.Cells(iRow, 17).Value = Me.txtrisk.Value
ws.Cells(iRow, 18).Value = Me.txtattach.Value
ws.Cells(iRow, 19).Value = Me.txtophase.Value
ws.Cells(iRow, 20).Value = Me.txtphase.Value
ws.Cells(iRow, 21).Value = Me.txtaddition.Value
ws.Cells(iRow, 22).Value = Me.txtlessons.Value
ws.Cells(iRow, 23).Value = Me.txtabc.Value
ws.Cells(iRow, 24).Value = Me.txtkeywords.Value
'clear the data
txtPart.Value = Format(Application.Max(ws.Range("A:A")) + 1, "000")
Me.txtLoc.Value = ""
Me.txtDate.Value = ""
Me.txtQty.Value = ""
Me.txtSdate.Value = ""
Me.txtldescription.Value = ""
Me.txtcauselesson.Value = ""
Me.txtlearned.Value = ""
Me.txtfirst.Value = ""
Me.txtlast.Value = ""
Me.txtemail.Value = ""
Me.txtphone.Value = ""
Me.ComboBox2.Value = ""
Me.txtBCat.Value = ""
Me.txtBSub.Value = ""
Me.ComboBox1.Value = ""
Me.txtrisk.Value = ""
Me.txtattach.Value = ""
Me.txtophase.Value = ""
Me.txtphase.Value = ""
Me.txtaddition.Value = ""
Me.txtlessons.Value = ""
Me.txtabc.Value = ""
Me.txtkeywords.Value = ""
Me.txtLoc.SetFocus
End Sub

Private Sub UserForm_Initialize()
txtPart.Value = Format(Application.Max(Sheets("View Lessons").Range("A:A")) + 1, "000")
End Sub
Click to expand...
 
Upvote 0
change:
txtSdate.Value = ""
to:
txtSdate.Value = Date

and add the same line to the end of UserForm_Initialize.
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
VBA Error Only Comments may appear after End Sub, Function or Property
Replies
4
Views
6K
JLGWhiz
JLGWhiz

Forum statistics

Threads
1,224,531
Messages
6,179,379
Members
452,907
Latest member
Roland Deschain

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