TextBox dependent Unique ID (Count through multiple tables)

Icesurf3r

New Member
Joined
Feb 13, 2013
Messages
39
I am creating a userform to record incoming business opportunities across multiple work-streams and need help with the Unique ID feature of the coding (appreciate this is a common question and I have looked, and looked again and Googled - but I couldn't find anything for my situation) as I'm using tables rather than worksheets.

My workbook structure is as follows:
Sheet 1 (Tracker) Table_Main
Sheet 2 (Go) Table_Go
Sheet 3 (No-Go) Table_NoGo

All the tables start with a header row in B2. Row 1 and Column A are blank.

On the Userform I have a textbox "Discipline", and to create the unique ID I would like to use the first three letters from the value of the "Discipline" text box (which contains 12 different disciplines) followed by a hyphen and then a three digit number i.e ABC-001, ABC-002, DEF-001 etc. Which will be saved into column 'C'.

So if the same discipline is selected the count increases by +1 for that discipline, but each disciplines count should start from 1 (if that makes sense).

Now the complicated part (not that it isn't all complicated - well for me anyway) When calculating the next number in the sequence I need to search the unique ID column of each table because as the opportunity progresses it will be moved to a different table. I also need to maintain the integrity of the count when closing and reopening the UserForm so they don't start from 1 again.

Below is the code I'm currently using to copy the Userform Data to the Table_Main and all the above needs to be part of the same button click.

Code:
Sub Add_Record()'Copy input values to Main Table
    Dim oNewRow As ListRow
    Dim rng As Range
    Set rng = ThisWorkbook.Worksheets("Tracker").Range("Table_Main")
    rng.Select
    Set oNewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
    With ws
        oNewRow.Range.Cells(1, 1).Value = UserForm1.DTPicker1.Value
        oNewRow.Range.Cells(1, 3).Value = UserForm1.ComboBox_Lots.Value
        oNewRow.Range.Cells(1, 4).Value = UserForm1.Discipline.Value
        oNewRow.Range.Cells(1, 5).Value = UserForm1.PrimaryLead1.Value
        oNewRow.Range.Cells(1, 6).Value = UserForm1.SecondaryLead1.Value
        oNewRow.Range.Cells(1, 7).Value = UserForm1.CbOpType.Value
        oNewRow.Range.Cells(1, 8).Value = UserForm1.TbOpName.Value
        oNewRow.Range.Cells(1, 9).Value = UserForm1.TbClientName.Value
        oNewRow.Range.Cells(1, 10).Value = UserForm1.CbDecision.Value
        oNewRow.Range.Cells(1, 11).Value = UserForm1.Tb_Notes.Value
    End With
    MsgBox "Opportunity has been added to Tracker", vbOKOnly
    Clear_Form
End Sub

Appreciate this is a big ask, but I would be very appreciative of any help received as I have only "Dabbled" in VBA and that was a few years ago, so I'm almost starting from scratch again.
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
and all the above needs to be part of the same button click.
Not necessarily.
I'd put another text box on the user form to hold the Unique ID and write it to the new row along with the other stuff.
Would populate this text box from _Afterupdate of the Discipline box.
Do a countif on each table for that Discipline, add them together and add 1.
Try testing this by itself to see
Code:
Sub Test_1()
Dim IDnum As Long, Displn As String
Displn = "ABC"      'would be Left(Me.Discipline.Value, 3)
IDnum = WorksheetFunction.CountIf(Sheets("Tracker").ListObjects("Table_Main").ListColumns(2).DataBodyRange, Displn) + _
        WorksheetFunction.CountIf(Sheets("Go").ListObjects("Table_Go").ListColumns(2).DataBodyRange, Displn) + _
        WorksheetFunction.CountIf(Sheets("No-Go").ListObjects("Table_NoGo").ListColumns(2).DataBodyRange, Displn) + 1
MsgBox Displn & "-" & Format(IDnum, "000")
End Sub
 
Upvote 0
Thanks for the response NoSParks,

Unfortunately I get a Run-Time error '5': Invalid procedure call or argument error.

When Debug is clicked all the code below is highlighted yellow with the cursor arrow pointing to the last line of this section of code.
Code:
IDnum = WorksheetFunction.CountIf(Sheets("Tracker").ListObjects("Table_Main").ListColumns(2).DataBodyRange, Displn) + _
              WorksheetFunction.CountIf(Sheets("Go").ListObjects("Table_Go").ListColumns(2).DataBodyRange, Displn) + _
              WorksheetFunction.CountIf(Sheets("No-Go").ListObjects("Table_NoGo").ListColumns(2).DataBodyRange, Displn) + 1

Will it make any difference to using the _Afterupdate function if the Discipline textbox is populated via a ComboBox_Lots_Change() Event? (code below)
Code:
Private Sub ComboBox_Lots_Change()

'Populates Primary Lead, Secondary Lead and Discipline text boxes based on ComboBox selection
If ComboBox_Lots.ListIndex > -1 Then
        PrimaryLead1.Value = Sheets("Lists").Range("Lots")(ComboBox_Lots.ListIndex + 1).Offset(, 4).Value
        SecondaryLead1.Value = Range("Lots")(ComboBox_Lots.ListIndex + 1).Offset(, 6).Value
        Discipline.Value = Range("Lots")(ComboBox_Lots.ListIndex + 1).Offset(, 2).Value
        CbOpType.Enabled = True
        CbOpType.Value = "Please Select"
        CbOpType.List = Sheets("Lists").Range("Type").Value
    Else
        PrimaryLead1.Value = ""
        SecondaryLead1.Value = ""
        Discipline.Value = ""
    End If
    
End Sub

Appreciate all the help so far
 
Upvote 0
Populate the new text box at the same time as those others
Code:
Private Sub ComboBox_Lots_Change()

    Dim IDnum As Long, Displn As String
    
'Populates Primary Lead, Secondary Lead and Discipline text boxes based on ComboBox selection
If ComboBox_Lots.ListIndex > -1 Then
        PrimaryLead1.Value = Sheets("Lists").Range("Lots")(ComboBox_Lots.ListIndex + 1).Offset(, 4).Value
        SecondaryLead1.Value = Range("Lots")(ComboBox_Lots.ListIndex + 1).Offset(, 6).Value
        Discipline.Value = Range("Lots")(ComboBox_Lots.ListIndex + 1).Offset(, 2).Value
        
        ' populate the new text box for UniqueID
        Displn = Left(Discipline.Value, 3)
        IDnum = WorksheetFunction.CountIf(Sheets("Tracker").ListObjects("Table_Main").ListColumns(2).DataBodyRange, Displn) + _
            WorksheetFunction.CountIf(Sheets("Go").ListObjects("Table_Go").ListColumns(2).DataBodyRange, Displn) + _
            WorksheetFunction.CountIf(Sheets("No-Go").ListObjects("Table_NoGo").ListColumns(2).DataBodyRange, Displn) + 1
        MsgBox Displn & "-" & Format(IDnum, "000")    'comment out or remove later
        'Me.What ever you named the added text box = Displn & "-" & Format(IDnum, "000")
        
        CbOpType.Enabled = True
        CbOpType.Value = "Please Select"
        CbOpType.List = Sheets("Lists").Range("Type").Value
        
    Else
        PrimaryLead1.Value = ""
        SecondaryLead1.Value = ""
        Discipline.Value = ""
    End If
    
End Sub
 
Upvote 0
Thanks NoSparks,

Progress is being made.

If I comment out the "IDnum =" section for all the CounIf statements, the code works and produces message box with the three letter value for the first half of the unique ID. However, if that section of the code isn't commented out it generates the Run-Time error '5': Invalid procedure call or argument.

I'll continue to tinker with the code to see if I can blindly stumble on the solution, but your continued help would also be appreciated.

Would it be helpful to include a sanitised version of the workbook?

Having Googled this extensively, there are a plethora of solutions for counting through worksheets, but none that I can find for counting through a particular column of multiple tables over several worksheets.
:(

But I'll keep looking and it's all good experience.

Thanks again.
 
Last edited:
Upvote 0
Would it be helpful to include a sanitised version of the workbook?
Definitely.
You can't load files to this forum but
There are free file sharing sites such as box.com and Dropbox where you can upload your file then post the share link back here on the forum.
 
Last edited:
Upvote 0
Please provide links to all cross postings of this question as per Forum Rules
Read the link in Rule 13 for an understanding.
 
Upvote 0
I can't actually 'run' your workbook.
I have Excel 2010 and none of these vba references which are all checked in your file.
- Microsoft Forms 2.0 Object Library
- Microsoft Windows Common Controls-2.6.0 (SP6)
- Microsoft Outlook 16.0 Object Library
also have no date picker and there isn't one in the file.

Don't know how you cleared your tables but it wasn't the same for all of them.
4 of your 5 tables have no data but do have a first row.
Table_Main does not have any rows at all, a .listrows.count is zero, for all the others it's 1.
I believe this is cause of the error you are getting.

Try putting this macro into a standard module and running it one line at a time using the F8 key.
Follow the comments if errors and let me know how it goes.
Code:
Sub Testing_1()
    Dim IDnum As Long, Displn As String
    Dim a As Long, b As Long, c As Long
    
Displn = "ABC"

'if errors on next line comment it out and continue
a = Application.CountIf(Sheets("Tracker").ListObjects("Table_Main").ListColumns(2).DataBodyRange, Displn)

If Sheets("Tracker").ListObjects("Table_Main").ListRows.Count > 0 Then _
    a = Application.CountIf(Sheets("Tracker").ListObjects("Table_Main").ListColumns(2).DataBodyRange, Displn)
If Sheets("Go").ListObjects("Table_Go").ListRows.Count > 0 Then _
    b = Application.CountIf(Sheets("Go").ListObjects("Table_Go").ListColumns(2).DataBodyRange, Displn)
If Sheets("No-Go").ListObjects("Table_NoGo").ListRows.Count > 0 Then _
    c = Application.CountIf(Sheets("No-Go").ListObjects("Table_NoGo").ListColumns(2).DataBodyRange, Displn)
    
IDnum = a + b + c + 1

'if errors on next line comment it out and continue
MsgBox Displn & "-" & Format(IDnum, "000")

MsgBox Displn & "-" & IDnum

End Sub
 
Upvote 0
Thanks,

The code above worked, and I have included the tweaked/lines commented out version that I used in my main code (after testing the code seperately via F8 as suggested) below:
Code:
Private Sub ComboBox_Lots_Change()


Dim IDnum As Long, Displn As String
Dim a As Long, b As Long, c As Long, d As Long, e As Long
    
' populate the new text box for UniqueID
Displn = "ABC" 'Left(Discipline.Text, 3)
If Sheets("Tracker").ListObjects("Table_Main").ListRows.Count > 0 Then _
    a = Application.CountIf(Sheets("Tracker").ListObjects("Table_Main").ListColumns(2).DataBodyRange, Displn)
If Sheets("Go").ListObjects("Table_Go").ListRows.Count > 0 Then _
    b = Application.CountIf(Sheets("Go").ListObjects("Table_Go").ListColumns(2).DataBodyRange, Displn)
If Sheets("No-Go").ListObjects("Table_NoGo").ListRows.Count > 0 Then _
    c = Application.CountIf(Sheets("No-Go").ListObjects("Table_NoGo").ListColumns(2).DataBodyRange, Displn)
If Sheets("Opt-In").ListObjects("Table_OptIn").ListRows.Count > 0 Then _
    d = Application.CountIf(Sheets("Opt-In").ListObjects("Table_OptIn").ListColumns(2).DataBodyRange, Displn)
If Sheets("Opt-Out").ListObjects("Table_OptOut").ListRows.Count > 0 Then _
    d = Application.CountIf(Sheets("Opt-Out").ListObjects("Table_OptOut").ListColumns(2).DataBodyRange, Displn)
If Sheets("Opt-Out").ListObjects("Table_OptOut").ListRows.Count > 0 Then _
    e = Application.CountIf(Sheets("Opt-Out").ListObjects("Table_OptOut").ListColumns(2).DataBodyRange, Displn)


IDnum = a + b + c + d + e + 1


'if errors on next line comment it out and continue
 MsgBox Displn & "-" & Format(IDnum, "000")


If I populate the reference number column with ABC across various sheets, the count works and the message box displays the correct number. However, when I substitute
Code:
Displn = "ABC"
for:
Code:
Displn = Left(Discipline.Text, 3)
or
Code:
Displn = Left(Discipline.Value, 3)
The count fails and just returns XXX-001 all the time. Even when I pre-populate the reference number column again.

We are getting closer, and I do appreciate all the time and effort your spending on this.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,237
Messages
6,170,924
Members
452,366
Latest member
TePunaBloke

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