Creating Consecutive numbers for data going to different worksheets with User Form

Yeft

New Member
Joined
Jan 6, 2023
Messages
35
Office Version
  1. 365
Platform
  1. Windows
Hello Guys,

I created a User form to save/update and search through saved data in different worksheets.
The Issue I have right now is that I don't know how to create a consecutive number per each data
entered, Keeping in mind that every worksheet should start adding consecutive numbers to each record starting from 0001 and so on.
All Data is saved elected from ( MainData Sheet) and pasted in each sheet with (CHOOSE COLS Function) based on the Box Number (Column G).

1717690790379.png


Unfortunately I have no idea on an easy way to attach the file or link it.

Any help on the whole issue is much appreciated.

Thank you,

Yeft


EDIT:
Sorry, Forgot to add...

Something I would need..... when opening the User Form and selecting what Box I'm going to put a record in, then the User Form would show the next Consecutive number available
for the next new record in that selected Box.

Thanks,
 

Attachments

  • 1717690324584.png
    1717690324584.png
    28.4 KB · Views: 5
Last edited by a moderator:

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Looking for a formula to generate the number, or vba to handle all of it? If the data was in P2 to P6 then this should get the last number
=MAXA(RIGHT(P2,4),RIGHT(P6,4)) so adding 1 should give you the next number. Then reference the helper cell on your form and add one to the last number right on the form.
5​
618_1-0001
618_1-0002
618_1-0003
618_1-0004
618_1-0005

VBA would be more robust IMO. If you altered format from 00001 to 001 or even 000001 you don't have to break things like a formula will. You also would not need the box column since the sheet name is the same.

You can't upload files here. Can only post a link to some kind of drop box. Note that not everyone will download files from such places.
 
Upvote 0
Unfortunately I have no idea on an easy way to attach the file or link it.
According to MS As you use 365 it's simple to share your documents but you can also share a copy of your workbook by using sharing tool like Dropbox – which a basic account can be downloaded & used for free.

Also helpful, would be to install MrExcel Addin XL2BB which allows you to provide a copy of your worksheet.

Hope Helpful

Dave
 
Upvote 0
Looking for a formula to generate the number, or vba to handle all of it? If the data was in P2 to P6 then this should get the last number
=MAXA(RIGHT(P2,4),RIGHT(P6,4)) so adding 1 should give you the next number. Then reference the helper cell on your form and add one to the last number right on the form.
5​
618_1-0001
618_1-0002
618_1-0003
618_1-0004
618_1-0005

VBA would be more robust IMO. If you altered format from 00001 to 001 or even 000001 you don't have to break things like a formula will. You also would not need the box column since the sheet name is the same.

You can't upload files here. Can only post a link to some kind of drop box. Note that not everyone will download files from such places.

Hello Micron

Thanks for helping. I just want to do it via VBA with the User Form. The way it should work is such that when I select the Box Number in the User From, then
the record will go straight and be saved to the Worksheet with the same name as the selected Box, and keep a consecutive number within that Worksheet, and It will be the same for the
others Worksheets. Please see below User Form:
1717764125777.png


Currently the VBA code works when saving all data in one sheet but it will just create consecutive numbers in the Main Data sheet, but the whole code may have to be changed.
For what I need I will have to change code for Save/Search/Next and Previous buttons too. Now it became a little too complex for me.
 
Upvote 0
According to MS As you use 365 it's simple to share your documents but you can also share a copy of your workbook by using sharing tool like Dropbox – which a basic account can be downloaded & used for free.

Also helpful, would be to install MrExcel Addin XL2BB which allows you to provide a copy of your worksheet.

Hope Helpful

Dave
Hello Dave,

Thank for putting an eye on this too. I'm trying to share a link for you guys to have a look at the file.

Thank you
 
Upvote 0
Hello There!

This is my code:
______________________________________________________________________________________

Dim lrow As Long
Dim activeRow As Long

Private Sub cmdExit_Click()
Dim iExit As VbMsgBoxResult

iExit = MsgBox("Do you wnat to exit the APP?", vbQuestion + vbYesNo, "Data Entry System")

If iExit = vbYes Then
Unload Me

End If

End Sub

Private Sub cmdNext_Click()

Dim FindRow
Dim cRow As String

On Error Resume Next

cRow = Me.Control1.Value

Set FindRow = Sheet2.Range("B:B").Find(What:=cRow, LookIn:=xlValues).Offset(1, -1)

If FindRow.Value = "" Then
MsgBox "You have reached the last Record"

ElseIf FindRow.Value = "" Then
Me.Control17.Value = Application.UserName 'Declaring User name For User Form
Me.Control2 = Format(Now(), "dd/mmm/yyyy") 'Declaring the Date for User Form
Me.Control18 = Format(Now(), "dd/mmm/yyyy")

End If


Me.txtSearch = ""

cNum = 19

For x = 0 To cNum
Me.Controls("Control" & x).Value = FindRow
Set FindRow = FindRow.Offset(0, 1)
Next

On Error GoTo 0

'TextBox14.Value = activeRow

End Sub

Private Sub cmdPrevious_Click()
Dim FindRow
Dim cRow As String

On Error Resume Next

cRow = Me.Control1.Value

Set FindRow = Sheet2.Range("B:B").Find(What:=cRow, LookIn:=xlValues).Offset(-1, -1)

If FindRow.Value = Sheet2.Range("B1").Value Then
MsgBox "You have reached the first Record"

If FindRow.Value = Sheet2.Range("B1").Value Then
Me.Control17.Value = Application.UserName 'Declaring User name For User Form
Me.Control2 = Format(Now(), "dd/mmm/yyyy") 'Declaring the Date for User Form
Me.Control18 = Format(Now(), "dd/mmm/yyyy")

End If
End If

Me.txtSearch = ""

cNum = 19

For x = 0 To cNum
Me.Controls("Control" & x).Value = FindRow
Set FindRow = FindRow.Offset(0, 1)
Next

On Error GoTo 0

'TextBox14.Value = activeRow

End Sub


Private Sub cmdSearch_Click()
Dim fpath As String

If Me.txtSearch.Value <> "" Then
Dim FindValue As Range
Set FindValue = Sheet2.Range("B:B").Find(What:=Me.txtSearch.Value, LookIn:=xlFormulas, LookAt:=xlWhole)

'Searching By Form ID

If WorksheetFunction.CountIf(Sheets("MainData").Range("B:B"), Me.txtSearch.Text) > 0 Then

Me.Control1.Value = FindValue.Value
Me.Control0.Value = FindValue.Offset(0, -1).Value
Me.Control2.Value = FindValue.Offset(0, 1).Value
Me.Control3.Value = FindValue.Offset(0, 2).Value
Me.Control4.Value = FindValue.Offset(0, 3).Value
Me.Control5.Value = FindValue.Offset(0, 4).Value
Me.Control6.Value = FindValue.Offset(0, 5).Value
Me.Control7.Value = FindValue.Offset(0, 6).Value
Me.Control8.Value = FindValue.Offset(0, 7).Value
Me.Control9.Value = FindValue.Offset(0, 8).Value
Me.Control10.Value = FindValue.Offset(0, 9).Value
Me.Control11.Value = FindValue.Offset(0, 10).Value
Me.Control12.Value = FindValue.Offset(0, 11).Value
Me.Control13.Value = FindValue.Offset(0, 12).Value
Me.Control14.Value = FindValue.Offset(0, 13).Value
Me.Control15.Value = FindValue.Offset(0, 14).Value
Me.Control16.Value = FindValue.Offset(0, 15).Value
Me.Control17.Value = FindValue.Offset(0, 16).Value
Me.Control18.Value = FindValue.Offset(0, 17).Value


Else
MsgBox "Data Not Found"

Me.Control1 = ""
Me.Control2 = ""
Me.Control3 = ""
Me.Control4 = ""
Me.Control5 = ""
Me.Control6 = ""
Me.Control7 = ""
Me.Control8 = ""
Me.Control9 = ""
Me.Control10 = ""
Me.Control11 = ""
Me.Control12 = ""
Me.Control13 = ""
Me.Control14 = ""
Me.Control15 = ""
Me.Control16 = ""
Me.Control17 = ""
Me.Control18 = ""

End If
End If

End Sub


Private Sub cmdSave_Click()

Call UnProtectSheet

Dim FORM_NUMBER As String
Dim REQ_DATE As String
Dim REQ_TYPE As String
Dim REQ_STATUS As String
Dim NOMENCLATURE As String
Dim DESCRIPTION As String
Dim BOX As String
Dim TRF_No As String
Dim QTY As String
Dim REQUESTED_BY As String
Dim SCAN_TEAMS As String
Dim MANUFACTURER As String
Dim MFR_NUMBER As String
Dim PO_NUMBER As String
Dim COMMENTS As String
Dim ETCHED As String
Dim UPDATED_BY As String
Dim UPDATE_DATE As String
Dim Row, Final As Long

' Code that looks for the Last Row
Row = 2
Do While Sheet2.Cells(Row, 1) <> Empty
Row = Row + 1
Loop
Final = Row - 1

Sheet2.Cells(Row, 2) = FORM_NUMBER
Sheet2.Cells(Row, 3) = Format(Now(), "dd/mmm/yyyy")
Sheet2.Cells(Row, 18) = Format(Now(), "dd/mmm/yyyy")

'AutoIncremnet (Consecutive Number)
Row = 2
Do While Sheet2.Cells(Row, 1) <> Empty
Row = Row + 1
Loop
Final = Row - 1
If Sheet2.Cells(2, 1) = Empty Then
FORM_NUMBER = 0 + 1
Else
FORM_NUMBER = Sheet2.Cells(Final, 2) + 1
End If


FORM_NUMBER = Control1.Value
REQ_DATE = Control2.Value
REQ_TYPE = Control3.Value
REQ_STATUS = Control4.Value
NOMENCLATURE = Control5.Value
DESCRIPTION = Control6.Value
BOX = Control7.Value
TRF_No = Control8.Value
QTY = Control9.Value
MANUFACTURER = Control10.Value
MFR_NUMBER = Control11.Value
PO_NUMBER = Control12.Value
COMMENTS = Control13.Value
REQUESTED_BY = Control14.Value
SCAN_TEAMS = Control15.Value
ETCHED = Control16.Value
UPDATED_BY = Control17.Value
UPDATE_DATE = Control18.Value


If MsgBox("Do you want to add a New Record?", vbYesNo + vbQuestion, "Question") = vbNo Then
Exit Sub
End If

a = 0
LastRow = Worksheets("MainData").Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To LastRow
If Worksheets("MainData").Cells(i, 2).Value = FORM_NUMBER Then
a = a + 1
End If
Next
If a >= 1 Then
MsgBox ("Req Id Already Exists!!. Please clear Info and start again.")
End If

If a = 0 Then

Worksheets("MainData").Cells(LastRow + 1, 2).Value = FORM_NUMBER
Worksheets("MainData").Cells(LastRow + 1, 3).Value = REQ_DATE
Worksheets("MainData").Cells(LastRow + 1, 4).Value = REQ_TYPE
Worksheets("MainData").Cells(LastRow + 1, 5).Value = REQ_STATUS
Worksheets("MainData").Cells(LastRow + 1, 6).Value = NOMENCLATURE
Worksheets("MainData").Cells(LastRow + 1, 7).Value = DESCRIPTION
Worksheets("MainData").Cells(LastRow + 1, 8).Value = BOX
Worksheets("MainData").Cells(LastRow + 1, 9).Value = TRF_No
Worksheets("MainData").Cells(LastRow + 1, 10).Value = QTY
Worksheets("MainData").Cells(LastRow + 1, 11).Value = MANUFACTURER
Worksheets("MainData").Cells(LastRow + 1, 12).Value = MFR_NUMBER
Worksheets("MainData").Cells(LastRow + 1, 13).Value = PO_NUMBER
Worksheets("MainData").Cells(LastRow + 1, 14).Value = COMMENTS
Worksheets("MainData").Cells(LastRow + 1, 15).Value = REQUESTED_BY
Worksheets("MainData").Cells(LastRow + 1, 16).Value = SCAN_TEAMS
Worksheets("MainData").Cells(LastRow + 1, 17).Value = ETCHED
Worksheets("MainData").Cells(LastRow + 1, 18).Value = UPDATED_BY
Worksheets("MainData").Cells(LastRow + 1, 19).Value = UPDATE_DATE


MsgBox "Recors Added Succesfully!"

End If

Call ProtectSheet

Call Reset

End Sub

Function Reset()

txtSearch = ""
Control1 = ""
'Control2 = "" 'We are not deleting Reqdate, as It should stay there by default.
Control3 = ""
Control4 = ""
Control5 = ""
Control6 = ""
Control7 = ""
Control8 = ""
Control9 = ""
Control10 = ""
Control11 = ""
Control12 = ""
Control13 = ""
Control14 = ""
Control15 = ""
Control16 = ""
'Control17 = "" 'We are not deleting UserName, as It should stay there by default.
Control18 = ""


End Function

Private Sub cmdClear_Click()
Dim Row, Final As Long

Row = 2
Do While Sheet2.Cells(Row, 1) <> Empty
Row = Row + 1
Loop
Final = Row - 1
If Sheet2.Cells(2, 2) = Empty Then
Control1 = 0 + 1
Else
Control1 = Sheet2.Cells(Final, 2) + 1
End If

Control17.Value = Application.UserName 'Declaring User name For User Form
Control2 = Format(Now(), "dd/mmm/yyyy") 'Declaring the Date for User Form
Control18 = Format(Now(), "dd/mmm/yyyy")

Me.txtSearch = ""
Me.Control0 = ""
'Me.Control1 = ""
Me.Control3 = ""
Me.Control4 = ""
Me.Control5 = ""
Me.Control6 = ""
Me.Control7 = ""
Me.Control8 = ""
Me.Control9 = ""
Me.Control10 = ""
Me.Control11 = ""
Me.Control12 = ""
Me.Control13 = ""
Me.Control14 = ""
Me.Control15 = ""
Me.Control16 = ""

End Sub

Private Sub UserForm_Initialize()
Dim Row, Final As Long
Dim cntr As Integer

Control17.Value = Application.UserName 'Declaring User name For User Form
Control2 = Format(Now(), "dd/mmm/yyyy") 'Declaring the Date for User Form
Control18 = Format(Now(), "dd/mmm/yyyy")


Row = 2
Do While Sheet2.Cells(Row, 1) <> Empty
Row = Row + 1
Loop
Final = Row - 1
If Sheet2.Cells(2, 2) = Empty Then
Control1 = 0 + 1
Else
Control1 = Sheet2.Cells(Final, 2) + 1
End If

cntr = Application.WorksheetFunction.CountA(Range("AA:AA")) ' Method 1 for Combo Box creating range List in Column AA of Sheet 2 "MainData"
For i = 1 To cntr
Me.Control7.AddItem Cells(i, 27)

Next i

cntr = Application.WorksheetFunction.CountA(Range("AB:AB")) ' Method 1 for Combo Box creating range List in Column AB of Sheet 2 "MainData"
For i = 1 To cntr
Me.Control3.AddItem Cells(i, 28)

Next i

cntr = Application.WorksheetFunction.CountA(Range("AC:AC")) ' Method 1 for Combo Box creating range List in Column AC of Sheet 2 "MainData"
For i = 1 To cntr
Me.Control15.AddItem Cells(i, 29)

Next i

cntr = Application.WorksheetFunction.CountA(Range("AD:AD")) ' Method 1 for Combo Box creating range List in Column AD of Sheet 2 "MainData"
For i = 1 To cntr
Me.Control4.AddItem Cells(i, 30)

Next i

cntr = Application.WorksheetFunction.CountA(Range("AE:AE")) ' Method 1 for Combo Box creating range List in Column AC of Sheet 2 "MainData"
For i = 1 To cntr
Me.Control16.AddItem Cells(i, 31)

Next i

End Sub

Private Sub cmdUpdate_Click()

Call UnProtectSheet

Dim FORM_NUMBER As String
Dim NOMENCLATURE As String

Control18.Text = Date

FORM_NUMBER = Trim(Control1.Text)
NOMENCLATURE = Trim(Control5.Text)

LastRow = Worksheets("MainData").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To LastRow

If Worksheets("MainData").Cells(i, 2).Value = FORM_NUMBER Or Worksheets("MainData").Cells(i, 5).Value = NOMENCLATURE Then

If MsgBox("Do you want to Update the Record ?", vbYesNo + vbQuestion, "Question") = vbNo Then
Exit Sub
End If

Worksheets("MainData").Cells(i, 18) = Format(Now(), "dd/mmm/yyyy")

Worksheets("MainData").Cells(i, 3).Value = Control2.Text
Worksheets("MainData").Cells(i, 4).Value = Control3.Text
Worksheets("MainData").Cells(i, 5).Value = Control4.Text
Worksheets("MainData").Cells(i, 6).Value = Control5.Text
Worksheets("MainData").Cells(i, 7).Value = Control6.Text
Worksheets("MainData").Cells(i, 8).Value = Control7.Text
Worksheets("MainData").Cells(i, 9).Value = Control8.Text
Worksheets("MainData").Cells(i, 10).Value = Control9.Text
Worksheets("MainData").Cells(i, 11).Value = Control10.Text
Worksheets("MainData").Cells(i, 12).Value = Control11.Text
Worksheets("MainData").Cells(i, 13).Value = Control12.Text
Worksheets("MainData").Cells(i, 14).Value = Control13.Text
Worksheets("MainData").Cells(i, 15).Value = Control14.Text
Worksheets("MainData").Cells(i, 16).Value = Control15.Text
Worksheets("MainData").Cells(i, 17).Value = Control16.Text
Worksheets("MainData").Cells(i, 18).Value = Application.UserName
Worksheets("MainData").Cells(i, 19).Value = Control18.Text


MsgBox "Record Updated Succesfully!"

End If
Next

Call ProtectSheet

Call Reset2

End Sub

Function Reset2()

txtSearch = ""
Control1 = ""
'Control2 = "" 'We are not deleting Reqdate, as It should stay there by default.
Control3 = ""
Control4 = ""
Control5 = ""
Control6 = ""
Control7 = ""
Control8 = ""
Control9 = ""
Control10 = ""
Control11 = ""
Control12 = ""
Control13 = ""
Control14 = ""
Control15 = ""
Control16 = ""
'Control17 = "" 'We are not deleting UserName, as It should stay there by default.
Control18 = ""


End Function
 
Upvote 0
Please enclose code in code tags (vba button on forum posting toolbar) to maintain indentation and readability. Some might read all of that; I won't. Best to only post the code that is applicable to your issue instead of all of it, unless your thread is about code feedback I guess.

So does that do what you want? It seems you are basing the next number on a count of rows that contain data in a column. That is risky as there's no guarantee that a cell won't get deleted, or you forget how that works and modify the sheet somehow, causing the row and item numbers get out of sync. In vba I would use the InstrRev function to find the first dash from the right, then get everything to the right of that, then increment that by 1. That relates to what I said before about vba being better for handling changes to formats. As long as a dash precedes the last number, it should be ok (as long as you don't start adding other characters such as letters).

Consider looping over controls instead of having 16 lines to do the same thing:
VBA Code:
Dim ctl As Control
Dim x As Integer
x = 3
For Each ctl in Me.Controls
    If TypeName(ctl) = "Textbox" And Instr(ctl.Name,"17") = 0 Then
        Worksheets("MainData").Cells(i, x).Value = Controls("Control" & x-1).Text
    End If
Next
Worksheets("MainData").Cells(i, 18).Value = Application.UserName
That is only one way; there are probably several other ways. One would be to use For...Next with a counter:
For x = 3 to 16, subtracting or adding as I did and then dealing with 17 and 18 separately. The method I used will ignore 17 because Instr looks for 17 in the name.
Lots of opportunity there to condense your code.
What happened to posting a link?
 
Upvote 0

Forum statistics

Threads
1,223,702
Messages
6,173,932
Members
452,539
Latest member
delvey

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