Code to Generate Sequential Code with a Prefix - excel

Question

I have a small userform with 1 combobox, 2 textbox and 1 command button. Image is attached.
Also the image of worksheet is attached below.
Upon Initialization of Userform, combobox is populated with account heads listed in Table1.
Selection of item from combobox will populate the textbox with Account Code listed in Table1.
Group Head textbox will be entered manually.
Below is my code...
Private Sub ComboBox1_Change()
Dim ws As Worksheet, tbl As ListObject, rng As Range, cmb As ComboBox
Dim accountcode As String, rng1 As Range
Set ws = Sheets("Sheet1")
Set tbl = ws.ListObjects("Table1")
Set rng = tbl.ListColumns(1).DataBodyRange
Set rng1 = tbl.ListColumns(2).DataBodyRange
Me.TextBox1.Value = Application.WorksheetFunction.Index(rng, Application.WorksheetFunction.Match(Me.ComboBox1.Value, rng1, 0))
End Sub
Private Sub CommandButton1_Click()
Dim ws As Worksheet, tbl As ListObject, row As ListRow
Set ws = Sheets("Sheet1")
Set tbl = ws.ListObjects("Table2")
Set row = tbl.ListRows.Add
prefix = Me.TextBox1.Value & "-"
Dim NextNum As Long
Dim LastRow As Long, lRow As Long
Dim myArr() As Long
With Sheets("Sheet1")
'Find Last Row in Group Head Code Column
LastRow = .Cells(.Rows.Count, "E").End(xlUp).row
ReDim myArr(1 To LastRow)
' read all cells contents and convert them to array of numbers
For lRow = 5 To LastRow
If Mid(.Cells(lRow, 5), 4) <> "" Then
myArr(lRow) = CLng(Mid(.Cells(lRow, 5), 4))
End If
Next lRow
' find maximum value in array
NextNum = WorksheetFunction.Max(myArr)
End With
row.Range(1, 1).Value = Me.ComboBox1.Value
row.Range(1, 2).Value = prefix & NextNum + 1
row.Range(1, 3).Value = Me.TextBox2.Value
End Sub
Private Sub UserForm_Initialize()
Dim ws As Worksheet, tbl As ListObject, rng As Range, cmb As ComboBox
Set ws = Sheets("Sheet1")
Set tbl = ws.ListObjects("Table1")
Set rng = tbl.ListColumns(2).DataBodyRange
Set cmb = Me.ComboBox1
For Each rng In rng
cmb.AddItem rng.Value
Next rng
End Sub
The command button reads the value in Table 2, COlumn and 2, Generate the serial number and post the values in the Table.
What i want with the command button is, if i select any other head from the combobox, the code should read the value associated with that prefix and then generate the next serial number. Currently it is not reading the prefix.
Kindly advise what changes need to be made in my command button code to achieve this.
Thanks
Salman

Answer 1

I think the problem you're experiencing is that you're trying to use Sheet1 as both the output display and data storage system. Often this isn't a problem, but in your case, it's causing you to have to search Table2 each time an entry is made.
You'd be better off using a module-level variable in VBA to keep track of the incrementing number for each code. There's also no need to look up Table 1 each time a selection is made. You could either store the codes in another module-level variable or exploit the ability for ComboBoxes to have more than one column. In the sample below I've gone for the latter because it's easy to read the ListObject straight into the combo box List property - if you want to go the same route, then you'd need to change the combo box ColumnCount property to 2 and, if you want the codes to be invisible, change the ColumnWidths property to something like 0 pt;130 pt.
Your code, then, could look something like the below:
Option Explicit
Private mNextInc() As Long
Private Function IndexOf(val As String, arr As Variant) As Long
Dim i As Long
'Get array index of lookup item
For i = 1 To UBound(arr, 1)
If arr(i, 1) = val Then
IndexOf = i
Exit Function
End If
Next
End Function
Private Sub ComboBox1_Change()
Me.TextBox1.Text = Me.ComboBox1.Value
End Sub
Private Sub CommandButton1_Click()
Dim tbl As ListObject
Dim rng As Range
Dim v As Variant
With Me.ComboBox1
'Create the output array
v = Array(.Text, _
.Value & "-" & mNextInc(.ListIndex), _
Me.TextBox2.Text)
'Write new row to table
Set tbl = ThisWorkbook.Worksheets("Sheet1") _
.ListObjects("Table2")
tbl.Range.Activate
If tbl.InsertRowRange Is Nothing Then
Set rng = tbl.HeaderRowRange.Offset(tbl.ListRows.Count + 1)
Else
Set rng = tbl.InsertRowRange
End If
rng.Value = v
'Increment the digit of code
mNextInc(.ListIndex) = mNextInc(.ListIndex) + 1
End With
End Sub
Private Sub UserForm_Initialize()
Dim tbl As ListObject
Dim lRow As ListRow
Dim rng As Range
Dim inc As Long
Dim i As Long
'Populate the combobox
Set rng = ThisWorkbook.Worksheets("Sheet1") _
.ListObjects("Table1").DataBodyRange
Me.ComboBox1.List = rng.Value
'Set the increment values to 1
ReDim mNextInc(rng.Rows.Count - 1)
For i = 1 To UBound(mNextInc)
mNextInc(i) = 1
Next
'Find current max value for each group head code
Set tbl = ThisWorkbook.Worksheets("Sheet1") _
.ListObjects("Table2")
For Each lRow In tbl.ListRows
With lRow.Range
i = IndexOf(.Cells(1), rng.Value)
inc = CLng(Mid(.Cells(2), 4, Len(.Cells(2)) - 3)) + 1
End With
If inc > mNextInc(i) Then mNextInc(i) = inc
Next
'Set the combo box to first item
Me.ComboBox1.ListIndex = 0
End Sub