How to set an automatically generated radio button to true in VBA? - excel

I am creating an Excel sheet in which the radio buttons are automatically generated based on the value of specific parameter. Please refer this for clear understanding:
A group of radio buttons are copied n number of times. where n is the number of rows that refers to a parameter.
Each radio buttons in this auto-generated matrix should be checked against a condition and one of the twelve radio button should be set to True in one group that matches the condition. The main complication here is that, each group of radio buttons are copied to required rows based on the requirement and so, the radio buttons are generated n*12 times and i don't know how to program each radio button that is generated automatically.
I need to know, which Function can I use to fulfill my requirement.
I have created the matrix with the following code:
Dim n, m, i, j, x, k, a As Integer
n = (Sheets("ALLO").Range("E4").Value) * 2
x = Sheets("ALLO").Range("E3").Value
m = (Sheets("ALLO").Range("E5").Value) + 1
a = m
For i = 2 To n Step 2
Sheets("Dummy_Result").Range("A2:M2").Copy Destination:=Sheets("Results").Range("A" & i)
Next i
For j = 3 To n Step 2
Sheets("Dummy_Result").Range("A3:M3").Copy Destination:=Sheets("Results").Range("A" & j)
Next j
For k = n + 1 To m Step 1
Sheets("Dummy_Result").Range("A3:M3").Copy Destination:=Sheets("Results").Range("A" & k)
Next k
End Sub
My updated Program, for generating the buttons automatically for the range dependent on the value of 'm'. The number of buttons generated should be directly proportional to the value of 'm'. This Program doesn't work when I use the dynamic range instead of Fixed range (As suggested by Mr.JosephC)
Sub Test()
Dim n, m, i, j, x, k, a As Integer
n = (Sheets("ALLO").Range("E4").Value) * 2 'No of Tack stations
x = Sheets("ALLO").Range("E3").Value
m = (Sheets("ALLO").Range("E5").Value) + 1
a = m
For i = 2 To n Step 2 'Correct
Sheets("Dummy_Result").Range("A2").Copy Destination:=Sheets("Results_1").Range("A" & i)
Call AddOptionButtons(Sheets("Results_1").Range("B & m: M & m"))
Next i
For j = 3 To n Step 2
Sheets("Dummy_Result").Range("A3").Copy Destination:=Sheets("Results_1").Range("A" & j)
Call AddOptionButtons(Sheets("Results_1").Range("B & m: M & m"))
Next j
For k = n + 1 To m Step 1
Sheets("Dummy_Result").Range("A3").Copy Destination:=Sheets("Results_1").Range("A" & k)
Call AddOptionButtons(Sheets("Results_1").Range("B & m: M & m"))
Next k
End Sub
Private Sub AddOptionButtons(ByRef TargetRange As Range)
Dim oCell As Range
For Each oCell In TargetRange
oCell.RowHeight = 20
oCell.ColumnWidth = 6
Dim oOptionButton As OLEObject
Set oOptionButton = TargetRange.Worksheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Left:=oCell.Left + 1, Top:=oCell.Top + 1, Width:=15, Height:=18)
oOptionButton.Name = "ob" & oCell.row & "_" & oCell.Column
'oOptionButton.Object.Caption = "Button" oOptionButton.Object.GroupName = "grp" & oCell.Top
Next
End Sub**strong text**
Please refer the Dummy result here

This is just something to get you started. Imagine you have 6 Form Controls Option buttons like this:
Then, if you pass them in an array buttons1 you may loop through them by their index and assign their value to True, based on another array with conditions condition1:
Public Sub TestMe()
Dim condition1 As Variant
condition1 = Array(False, True, False, False, False, False)
Dim buttons1 As Variant
buttons1 = Array("Option Button 2", "Option Button 3", "Option Button 4", _
"Option Button 5", "Option Button 6", "Option Button 7")
Dim cnt As Long
For cnt = LBound(buttons1) To UBound(buttons1)
With Worksheets(1).Shapes(buttons1(cnt)).OLEFormat
If condition1(cnt) Then .Object.Value = True
End With
Next cnt
End Sub
Thus, after running the code, as far as the second unit in the condition1 array is True, the Option Button 3 is selected.

This will add option buttons to each cell in the target range. It will resize the cells a bit to try and make enough space for them (you can fiddle with placement of the option buttons and size of the cells as you see fit). It will name the option buttons with their "index" values based on the row and column numbers they are set in ie. ob2_4 is option button in row 2, column 4 (D). It will also set the group name to be the same for all option buttons on the same row.
Sub Test()
Call AddOptionButtons(Sheet1.Range("B5:D7"))
End Sub
Private Sub AddOptionButtons(ByRef TargetRange As Range)
Dim oCell As Range
For Each oCell In TargetRange
oCell.RowHeight = 20
oCell.ColumnWidth = 6
Dim oOptionButton As OLEObject
Set oOptionButton = TargetRange.Worksheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Left:=oCell.Left + 1, Top:=oCell.Top + 1, Width:=15, Height:=18)
oOptionButton.Name = "ob" & oCell.Row & "_" & oCell.Column 'Name them to make it easier if you need to access them later
'oOptionButton.Object.Caption = "Caption" ' If you want to add text to the buttons
oOptionButton.Object.GroupName = "grp" & oCell.Top
Next
End Sub
Personal note:
As an aside, please use meaningful names for your variables. :) The only time you should use single character variables is if you have hardware requirements on the footprint of your code.

Related

loop through all comboboxes in userform and validate with name and make them visible

I have a userform in which pages and then on one page contain a lot of comboboxes all of them have a pattern in their name as per their location for example in first row I have 3 comboboxes their names are:
AO11, AO12, AO13
Second row has 04 comboboxes with following names
AO21, AO22, AO23, AO24
Third row has 04 Comboboxes with following names
AO31, AO32, AO33, AO34
and so on till 12~15 Comboboxes
X represents row number when which will start with X=1 because first row will always be visible.
once user press AddNewCMD it should make visible the next row of comboboxes with the following code:
Private Sub AddNewCMD_Click()
If X = 2 Then
Me.AO21.Visible = True
Me.AO22.Visible = True
Me.AO23.Visible = True
Me.AO24.Visible = True
X = X + 1
ElseIf X = 3 Then
Me.AO31.Visible = True
Me.AO32.Visible = True
Me.AO33.Visible = True
Me.AO34.Visible = True
X = X + 1
End If
End Sub
in AO21
2 represents row number
1 represent first combo in row two
however I realize that it will be very long code as if I add further rows in therefore I am search for a way that can loop through each comboboxes and validate x with its name and make them visible?
same goes for hiding the comboboxes.
Please, copy the next code in the userForm code module:
Option Explicit
Private nextRow As Long
Private Sub AddNewCMD_Click()
Dim i As Long, ctrl As MSForms.Control, boolVis As Boolean
If nextRow = 0 Then
nextRow = 2
Else
nextRow = nextRow + 1
End If
Debug.Print nextRow
For i = 0 To Me.MultiPage1.Pages(0).Controls.count - 1
Set ctrl = Me.MultiPage1.Pages(0).Controls(i)
If TypeOf ctrl Is MSForms.ComboBox Then
If CLng(Right(ctrl.Name, Len(ctrl.Name) - 2)) > 13 Then
Debug.Print ctrl.Name, ctrl.Visible
If CLng(Mid(ctrl.Name, 3, 1)) = nextRow Then
ctrl.Visible = True: boolVis = True
End If
End If
End If
Next i
If Not boolVis Then MsgBox "The row " & nextRow & " does not exist..."
End Sub
ClickingAddNewCMD button will make the next combos row visible. When the existing rows are all made visible, a message stating that no any row available will be raised.
You did not answer my clarification questions... But if only one such combo row should be visible (except the first one, or including), I can make a function to determine it, but this can be done only if you supply a logic algorithm based on what to proceed.

Adding data on excel sheet

I have a list of data like this:
I want to add tests from Column N to X bu using a userform.
in the userform i have a combobox populated like this:
For example if add test D for the 1st time it should be Added on column 3, if I add a 2nd test D it should be Added on column 4... If I add test A for the 1time it should be Added on column 1, the seconde test A should be Added on column 2.... (like in the 1st pic)
Each time the name of persons and service is added automatically.
I am trying to set a condition to be able to get what I want I've writen this code:
' code for the button on my worksheet
Private Sub CommandButton1_Click()
'-------------Populate the comobox of persons and tests
Dim ws_Liste_Pers As Worksheet
Set ws_Liste_Pers = ActiveWorkbook.Worksheets("service ")
Fin_Liste_Pers = ws_Liste_Pers.Range("A65530").End(xlUp).Row
For i = 2 To Fin_Liste_Pers
UserForm_SDE.ComboBox_Demandeur.AddItem ws_Liste_Pers.Range("A" & i)
Next i
Dim ws_tech_essais As Worksheet
Set ws_tech_essais = ActiveWorkbook.Worksheets(" tech essais")
Fin_Liste_tech_essais = ws_tech_essais.Range("A65530").End(xlUp).Row
For i = 2 To Fin_Liste_tech_essais
UserForm_SDE.ComboBox_Tech_Essai.AddItem ws_tech_essais.Range("A" & i)
Next
UserForm_SDE.Show
End Sub
'Code for the userfom to add the data
Private Sub CommandButton1_Click()
TPers = Feuil2.[A2].Resize(Feuil2.[A1000000].End(xlUp).Row - 1, 2).Value
ReDim TPlaces(0 To ComboBox_Tech_Essai.ListCount - 1)
Dim LP As Long, LS As Long, CS As Long
LP = ComboBox_Demandeur.ListIndex + 1
' If LP = 0 Then Exit Sub
' If Not ComboBox_Tech_Essai.MatchFound Then Exit Sub
CS = TPlaces(ComboBox_Tech_Essai.ListIndex) + 1: If CS < 14 Then CS = 14
TPlaces(ComboBox_Tech_Essai.ListIndex) = CS
On Error Resume Next
LS = WorksheetFunction.Match(TPers(LP, 3), Feuil2.[A:A], 0)
If Err Then LS = 0
On Error GoTo 0
If LS > 0 Then If Not IsEmpty(Feuil2.Cells(LS, CS).Value) Then LS = 0
If LS = 0 Then
LS = Feuil1.[A1000000].End(xlUp).Row + 1
Feuil1.Cells(LS, 1) = TPers(LP, 1)
' Feuil1.Cells(LS, 2) = TPers(LP, 2)
End If
Feuil1.Cells(LS, CS) = ComboBox_Tech_Essai.Value
Unload Me
End Sub
The problem is that this code is adding the tests only on column N.
Can anyone help me to find teh pb. Thank you
Use the next code, please. In order to properly work, it needs the strings matching the test numbers (from the sheet) to be exactly formatted like in the combo box I mean, like "001", "002" .... I did not observe how you loaded the combo, but it would be necessary to do the same for the range in H:H column. The best text format is obtained by selecting the column in discussion and then: Data tab -> Text to Columns... -> Next -> Next, then check 'Text' in 'Column data format' and press 'Finish':
Private Sub CommandButton1_Click()
Dim sh As Worksheet, rngTNo As Range, rngCol As Range, iRow As Long, i As Long
Dim ComboBox_No As MSForms.ComboBox, ComboBox_Test As MSForms.ComboBox
'use in the next row your real combo boxes. I named mine ComboBox_No, respectively, ComboBox_Test
'You will use something like: Me.ComboBox_Tech_Essai, Me.ComboBox_Demandeur...
Set ComboBox_No = frmTest.ComboBox_No: Set ComboBox_Test = frmTest.ComboBox_Test
Set sh = ActiveSheet 'Feuil2
Set rngTNo = sh.Range("H7:H" & sh.Range("H" & Rows.count).End(xlUp).Row) 'Test numbers range
If rngTNo.cells.count < 1 Then MsgBox _
"There necessary Test numbers range is missing...": Exit Sub
If rngTNo.NumberFormat <> "#" Then MsgBox _
"The Test numbers range must be formatted as text!": Exit Sub
iRow = rngTNo.Find(ComboBox_No.Value).Row 'row to be used for dropping the test
For i = 14 To 25
Set rngCol = sh.Range(sh.cells(7, i), sh.cells(sh.cells(Rows.count, i).End(xlUp).Row, i))
If rngCol.Find(ComboBox_Test.Value) Is Nothing Then
If sh.cells(iRow, i).Value = "" Then
sh.cells(iRow, i).Value = ComboBox_Test.Value: Exit For
End If
End If
Next
End Sub
You have this line of code:
CS = TPlaces(ComboBox_Tech_Essai.ListIndex) + 1: If CS < 14 Then CS = 14
Which is setting the column index you use near the end of your sub:
Feuil1.Cells(LS, CS) = ComboBox_Tech_Essai.Value
14 = N so with the statement If CS < 14 Then CS = 14 the code will never populate a column before N.
#FaneDuru
To do simple look at this picture:
I want to choose the test number from a combobox, and then add the test by chosing it from a combox like this :
when adding a new test the code should look for the test N° on column H and the the name of the chosen test from the combobox, if the test exsits in column N it should be adde in M, if we select the same test the code must add it on the column O ...
column
in the same column I must not have the same test Name, look at the 1st picture for test A in green. ( I have selcted 001 from the combobox so tets A was Added on column N, a second test A N°001 its Added in column M)
For test B in yellow you see that the first value is in column P, because I have selected tets N° OO1, for the 2nd test B I have choosen test Number 002 from the combobox so it was added on column N

how to not enter if statement inside a loop if it have been executed

I have a for loop, and inside it i have if statement.
In my Excel I have a list that contains each value one time. Once I found it i don't want the code to even check the conditional, i want it to skip this part of the if statement completely each time the loop is executed, is it possible?
Here is my code and list:
the first iteration of the loop will find that "c" is the value so it will do what inside it (xc = i)
I don't want the code to even check "ElseIf Cells(1, i) = "c" again, like the following image, is this possible?
code as text:
Sub test()
Dim i, xa, xb, xc As Integer
For i = 1 To 5
If Cells(i, 1) = "a" Then
xa = i
ElseIf Cells(i, 1) = "b" Then
xb = i
ElseIf Cells(i, 1) = "c" Then
xc = i
End If
Next i
End Sub
My initial interpretation of your need was "if the code hits 'c' again, just don't act".
To do so, you could modify the logic as follows:
ElseIf (xc = 0) And (Cells(i, 1) = "c") Then
This way, as soon as xc is set, the first boolean expression would be False, and the overall condition would not ever be met again. As mentioned by #TimWilliams, VBA would still evaluate the second boolean expression, unlike other languages that feature short-circuiting options. #Gene's answer describes a way around this. Typically, for better performance, you would evaluate the simple conditions first, before resorting to costly ones.
Additional notes
In VBA, you must give a type to each variable. In your Dim line, only xc is an Integer, while the other variables are Variants.
An unqualified Cells() call operates on the currently active worksheet, which might not be the expected one. Suggestion: qualify Cells() with the CodeName of your worksheet. The CodeName is what you see or specify under a worksheet's (Name) property as seen from the Visual Basic editor. For example, if (Name) is Sheet1, use Sheet1.Cells(). This will only work if the code resides in the same workbook as Sheet1. If the code is behind the worksheet itself, you can even use Me.Cells().
When dealing with cell values as your code does, VBA is (silently) being nice and understands that, among the numerous properties of the Range class, Value is what you are interested in. It is better practice, however, to explicitly state the target property, such as in Sheet1.Cells(i, j).Value.
EDIT
Knowing the values will be distinct and that there are about 60 of them, I suggest you simply use a Dictionary, as shown below, to get each value's row in one go, without a cascade of Ifs:
Option Explicit
Sub test()
Dim i As Integer
Dim dict As Object 'Scripting.Dictionary
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To 5
dict(Cells(i, 1).Value) = i
Next
Debug.Print dict("a") '4
Debug.Print dict("b") '2
Debug.Print dict("c") '1
'Etc.
End Sub
if i understood your question you can try this code:
Sub test()
Dim i, xa, xb, xc As Integer
Dim a, b, c As Boolean
a = False
b = False
c = False
For i = 1 To 5
If Cells(i, 1) = "a" And a <> True Then
xa = i
a = True
ElseIf Cells(i, 1) = "b" And b <> True Then
xb = i
b = True
ElseIf Cells(i, 1) = "c" And c <> True Then
xc = 1
c = True
End If
Next i
End Sub
Boolean variable is setted true for example only when the cells(i,1)="a" and after the next "a" value are skipped...
hope this helps
I just wanted to "mod" Ferdinando's code so it's a bit more "readable", I think. The main (the substantive) difference between this version and Ferdinando's or Excelosaurus' is that the cell is not even tested once the value is detected. Remember that the question was: I don't want the code to even check "ElseIf Cells(1, i) = "c" again... So, this version does exactly that.
Sub test()
Dim i As Integer, xa As Integer, xb As Integer, xc As Integer
Dim aFound As Boolean, bFound As Boolean, cFound As Boolean
Dim r As Range
For i = 1 To 5
Set r = Cells(i, 1)
If Not aFound Then
If r = "a" Then xa = i: aFound = True
ElseIf Not bFound Then
If r = "b" Then xb = i: bFound = True
ElseIf Not cFound Then
If r = "c" Then xc = i: cFound = True
End If
Next i
End Sub
I don't like the idea of 60 ElseIfs. Please examine the code below. In order to test it, create a worksheet called "TestSheet" and enter your A1:A5 to cells H2:H6.
Sub TestSpike()
' 06 Jan 2019
Dim Rng As Range
Dim Items As Variant
Dim Spike As String
Dim Tmp As String
Dim i As Integer
Dim R As Long
Items = Split("c|b|0|a|1", "|")
With Worksheets("TestSheet").Columns("H")
For R = 2 To 6
Tmp = CStr(.Cells(R).Value)
If InStr(1, Spike, Tmp, vbTextCompare) = 0 Then
Spike = Spike & "|" & Tmp
On Error Resume Next
i = Application.WorksheetFunction.Match(Tmp, Items, 0)
If Err Then
MsgBox Tmp & " wasn't found in Array"
Else
MsgBox "i = " & i & " = Item " & Tmp
End If
End If
Next R
End With
End Sub
The code has a "Spike". Each item is first checked against the Spike. If it is found there no further tests are carried out. Else, it is added to the Spike.
New items, after being added to the Spike, are checked against the Array "Items" which would hold your 60 elements, separated by Chr(124) thus, Split("c|b|0|a|1", "|"). I use the worksheet function MATCH to look for the item in the array. The result is an index number (or an error, if not found). You can use this index number in a Select Case statement to process each item distinct from others, basically the same way as you now process it when the If statement returns True.
One idea you may find useful with this kind of setup is to use the index from the Match function to return a value from another array. The other array might, for example, contain function names and you use Application.Run to call a different function for each item. This would run significantly faster than examining 60-odd Select Case statements.

Blank cell contains a value when code is executed

I’m using a userform with 12 listboxes (numbered 2-13). Each list box could contain 0-8 items assigned by user from main listbox1. I run the following code to output the content of each list box (12 boxes) to sheet “Tray” when a button is pressed.
Each listbox is then output into corresponding columns of each tray from columns B-M. Listbox2 fills column 1 of each tray and so on. A maximum of 4 trays can be filled. The code checks the 1st well of each tray and if it contains a value it assumes the tray is full & begins filling the next tray.
Problem: If the first tray contains a blank column(listbox) and the second tray contains values in the same listbox, the code will fill blank column of the frist tray with values that should be in the second tray. Please see pictures below and updated code below:
Listboxes 2,3 and 4 for Tray 1 (note listbox3 is empty)
Listboxes 2,3 and 4 for tray 2 (note listbox3 has data)
Code ran two times: Listbox3 from tray2 appears in tray1 (erroneously!!!)
Expected output:
Sub Worklist()
'
Dim Var, VarName As Variant
Dim i, DblDashPos, FirstPeriodPos, lngColNum, lngRowNum As Long
Dim item As ListBox
Const cstrNames As String = "Listbox2,Listbox3,Listbox4,Listbox5,Listbox6,Listbox7,Listbox8,Listbox9,Listbox10,Listbox11,Listbox12,Listbox13"
Application.ScreenUpdating = False
lngColNum = 2
For Each VarName In Split(cstrNames, ",")
If UserForm2.Controls(VarName).ListIndex <> -1 Then 'if listbox is not blank
If Sheets("Tray").Cells(4, lngColNum).Value = 0 Then
'checks if value in row 3 column "lngColNum" is empty
lngRowNum = 4
ThisWorkbook.Sheets("Tray").Range("C2").Value = UserForm2.TextBox1.Value
ElseIf Sheets("Tray").Cells(15, lngColNum).Value = 0 Then 'checks if value in row 14 column "lngColNum" is empty
lngRowNum = 15
ThisWorkbook.Sheets("Tray").Range("C13").Value = UserForm2.TextBox1.Value
ElseIf Sheets("Tray").Cells(26, lngColNum).Value = 0 Then 'checks if value in row 14 column "lngColNum" is empty
lngRowNum = 26
ThisWorkbook.Sheets("Tray").Range("C24").Value = UserForm2.TextBox1.Value
Else 'otherwise assumes tray starts in row 5, column "lngColNum"
lngRowNum = 37
ThisWorkbook.Sheets("Tray").Range("C35").Value = UserForm2.TextBox1.Value
End If
For i = 0 To UserForm2.Controls(VarName).ListCount - 1
Var = UserForm2.Controls(VarName).List(i)
DblDashPos = InStr(1, Var, "--")
FirstPeriodPos = InStr(1, Var, ".")
Sheets("Tray").Select
ActiveSheet.Cells(lngRowNum, lngColNum) = Left(Var, DblDashPos - 1) & Right(Var, Len(Var) - FirstPeriodPos + 1)
lngRowNum = lngRowNum + 1
Next i
End If
lngColNum = lngColNum + 1
Next
Application.ScreenUpdating = True
End Sub
Thank you very much!
The problem is that you're only testing the column that corresponds to the ListBox to see if the cell is empty. If you want to test that all of the columns in a "tray" are empty, you need to test once for the entire sheet. Something like this (untested because I'm too lazy to rebuild your form):
Private Function FindFirstUnusedRow(sheet As Worksheet) As Long
Dim testColumn As Long, testRow As Long
Dim used As Boolean
For testRow = 4 To 37 Step 11
used = False
For testColumn = 2 To 13
If IsEmpty(sheet.Cells(testRow, testColumn)) = False Then
used = True
Exit For
End If
Next testColumn
If used = False Then
FindFirstUnusedRow = testRow
Exit For
End If
Next testRow
End Function
Then in your code, call it before your loop:
Sub Worklist()
Dim var As Variant
Dim i As Long, dashPos As Long, periodPos As Long, colNum As Long
Dim rowNum As Long, Dim sheet As Worksheet
Application.ScreenUpdating = False
Set sheet = ThisWorkbook.Sheets("Tray")
rowNum = FindFirstUnusedRow(sheet)
If rowNum = 0 Then
Debug.Print "All trays full."
Exit Sub
End If
Dim current As ListBox
For colNum = 2 To 13
Set current = UserForm2.Controls("Listbox" & colNum)
If current.ListIndex <> -1 Then 'if listbox is not blank
sheet.Cells(rowNum - 2, colNum).Value = UserForm2.TextBox1.Value
For i = 0 To current.ListCount - 1
var = current.List(i)
dashPos = InStr(1, var, "--")
periodPos = InStr(1, var, ".")
sheet.Cells(rowNum + i, colNum) = Left$(var, dashPos - 1) & _
Right$(var, Len(var) - periodPos + 1)
Next i
End If
Next colNum
Application.ScreenUpdating = True
End Sub
A couple other notes: You can ditch the Sheets("Tray").Select line entirely - you never use the selection object. Same thing with the mixed references to ActiveSheet and ThisWorkbook.Sheets("Tray"). Grab a reference and use it.
Also, these lines don't do what you think they do:
Dim Var, VarName As Variant
Dim i, DblDashPos, FirstPeriodPos, lngColNum, lngRowNum As Long
Of all the variables you declare, everything is a Variant except lngRowNum. If you want to combine declarations on one line like that, you still need to specify a type for each variable, or they'll default to Variant. See the example code above.

Generation of sequential serial number based on prefix value

We have prefix defined already (say ABC, GIJ, THK, JLK ...so on) and want to create a sequential number when a user wants to generate a number for each of these prefix like given below:
ABC0000 , ABC0001 , ABC0002 ...ABC9999 same for GIJ0000 , GIJ0001 , GIJ0002 ...GIJ9999.
Given below is the code written for the above logic, but it does not achieve the requirement:
Private Sub CommandButton1_Click()
With ComboBox1.Value
Dim a, b As String
Dim i, j, k, l, x, q, m, temp As Long
a = ComboBox1.Text
i = Application.WorksheetFunction.Match(a, Range("A1:A1000"), 0)
j = Cells(i, 2)
l = j * 1000
For q = 2 To 100
For m = 2 To 100
If Cells(q, m).Value < 0 Then
k = m
End If
Next
Next
x = l
If Cells(i, GC).Value = temp Then
click = click + 1
Else
click = 0
End If*
Cells(i, GC) = x + click
TextBox1.Text = x + click
temp = Cells(i, GC).Value
End With
GC = GC + 1
End Sub
VBA does not seem necessary for this. Assuming you have your prefixes in separate cells in ColumnA starting in Row1, put in B1:
=A1&TEXT(COUNTIF(A$1:A1,A1)-1,"0000")
and double-click its fill handle.
From your code, I assume that you have a ComboBox named ComboBox1, a CommandButton named CommandButton1 and a TextBox named TextBox1, all on a UserForm, and with ComboBox1 filled with the possible values for prefixes.
The following code will put the next available code(1) for the selected prefix into the TextBox.
Private Sub CommandButton1_Click()
Dim a As String
Dim i As Long, j As Long
a = ComboBox1.Text
i = Application.WorksheetFunction.Match(a & "9999", Range("A1:A1000"), 1)
j = CLng(Mid$(Cells(i, 1).Value, Len(a) + 1)) + 1
TextBox1.Text = a & Format(j, "0000")
End Sub
Your code is also doing a lot of unnecessary stuff.
(1) only if data is sorted.

Resources