Generation of sequential serial number based on prefix value - excel

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.

Related

Add multiple checkbox caption in List box in User Form

enter image description here
Many thanks for your reply, Please find attached a picture of the user form I Got the data in the list box by some other ways no I am facing an issue to update and edit the data. I am trying to call the data from Listbox to textbox and checkboxes by below code for Editing.
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'UPDATE LISBOX DATA
Dim p As Integer
Me.ComboBoxitem.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
For p = 0 To Me.ListBox1.ListCount < 1
Me.CheckBoxSmall.Value = Me.ListBox1.List(p, 3)
Me.CheckBoxMedium.Value = Me.ListBox1.List(p, 3)
Me.CheckBoxLarge.Value = Me.ListBox1.List(p, 3)
Me.CheckBoXL.Value = Me.ListBox1.List(p, 3)
Me.CheckBoXXL.Value = Me.ListBox1.List(p, 3)
Me.CheckBoXXXL.Value = Me.ListBox1.List(p, 3)
Me.txtsmallqty.Value = Me.ListBox1.List(p, 4)
Me.TextBoxmedium.Value = Me.ListBox1.List(p, 4)
Me.TextBoxlarge.Value = Me.ListBox1.List(p, 4)
Me.TextBoXL.Value = Me.ListBox1.List(p, 4)
Me.TextBoxxL.Value = Me.ListBox1.List(p, 4)
Me.TextBoxxxL.Value = Me.ListBox1.List(p, 4)
Next
Me.TextBox1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)
End Sub
and for update the data in excel sheet after editing , I am using below code :
Private Sub CommandButton1_Click() ' Update Data
Dim L As Long
Dim th As Worksheet
Set th = ThisWorkbook.Sheets("Data")
L = Application.WorksheetFunction.Match(CLng(Me.TextBox1.Value), th.Range("A1:A1000"), 0)
th.Range("B" & L) = Me.ComboBoxitem.Value
th.Range("D" & L) = Me.CheckBoxSmall.Value
th.Range("D" & L) = Me.CheckBoxMedium.Value
th.Range("D" & L).Value = Me.CheckBoxLarge.Value
th.Range("D" & L).Value = Me.CheckBoXL.Value
th.Range("D" & L).Value = Me.CheckBoXXL.Value
th.Range("D" & L).Value = Me.CheckBoXXXL.Value
th.Range("E" & L) = Me.txtsmallqty.Value
th.Range("E" & L) = Me.TextBoxmedium.Value
th.Range("E" & L) = Me.TextBoxlarge.Value
th.Range("E" & L) = Me.TextBoXL.Value
th.Range("E" & L) = Me.TextBoxxL.Value
th.Range("E" & L) = Me.TextBoxxxL.Value
Me.CheckBoxSmall.Value = False
Me.CheckBoxMedium.Value = False
Me.CheckBoxLarge.Value = False
Me.CheckBoXL.Value = False
Me.CheckBoXXL.Value = False
Me.CheckBoXXXL.Value = False
Me.txtsmallqty.Value = ""
Me.TextBoxmedium.Value = ""
Me.TextBoxlarge.Value = ""
Me.TextBoXL.Value = ""
Me.TextBoxxL.Value = ""
Me.TextBoxxxL.Value = ""
Me.TextBox1.Value = ""
End Sub
Addition due to comment:
"I am trying to pull Listbox data in 6 checkboxes and 6 text boxes from the first code mention above, the Issue I am facing from this code, shows only data from the first line of Listbox to all text boxes and checkboxes.
By the mean of the second code I have to update data in excel sheet."
But I am not able to get the perfect result, you are requested to please review the above Code and let me know where I am Mistaking.
Your Kind Response will be Highly Appreciated.
As you are displaying always six rows per chosen item (corresponding to six sizes of Small,Medium,...,XXXL) with item info only in the 1st row, a main issue is to get the correct .ListIndex by doubleclicking to any row within the listbox.
1. The start row index p (containing the serial# and product name) can be calculated from the currently double clicked .ListIndex using an int(eger) division multiplied by six rows to get to the first row (see section 1):
p = (Me.ListBox1.ListIndex \ 6) * 6
Example: a double click into .ListIndex of 0..5 results in the start row index p = 0, of 6..11 in 6, ... - i.e. always returning the first row of a bundle of six rows containing sizes.
2. To avoid endless assignments I defined two variant arrays (chkboxes and txtboxes) containing the checkbox and textbox names (see section 2). - Another frequently used method consists in enumerating the control names facilitating assignments in a later loop.
3. The 3rd step assigns the listbox'es main info (3a) and the size-related values (3b) to all single controls; the latter action is executed in a loop referring to the controls via Me.Controls(chkboxes(i)).Value and Me.Controls(txtboxes(i)).Value.
The following code example should give you a start and allow to finish the 2nd procedure by yourself (remind: don't overload a post by too many independant questions, focus to one issue :-;)
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'UPDATE LISBOX DATA
'1. get the start row containing the serial code,
' (even if doubleclicked in one of the five following rows)
Dim p As Long ' instead of Integer
p = (Me.ListBox1.ListIndex \ 6) * 6 ' each item has 6 rows (sizes available)
'2. define arrays containing checkbox|textbox names
Dim chkboxes, txtboxes
chkboxes = Split("CheckBoxSmall,CheckBoxMedium,CheckBoxLarge,CheckBoXL,CheckBoXXL,CheckBoXXXL", ",")
txtboxes = Split("txtsmallqty,TextBoxmedium,TextBoxlarge,TextBoXL,TextBoXXL,TextBoxxxL", ",")
'3. a) write item name & Serial# to corresponding userform controls
Me.ComboBoxitem.Value = Me.ListBox1.List(p, 1) ' Item name
Me.TextBox1.Value = Me.ListBox1.List(p, 0) ' Serial number
'3. b) loop through all six rows representing sizes
Dim i As Long
For i = 0 To 5 ' listbox items and both ctrl arrays are 0-based!
Me.Controls(chkboxes(i)).Value = CBool(Me.ListBox1.List(p + i, 3)) ' 4th column has index 3!
Me.Controls(txtboxes(i)).Value = Me.ListBox1.List(p + i, 4) ' 5th column has index 3!
Next i
End Sub

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

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.

How do I modify a sample code for primefactorization in Excel VBA to a specific column of numbers?

I have in Column K:
K8 is 6384 i.e. =SUM(J1:J8)
K9 is 2598 i.e. =SUM(J2:J9)
K10 is 12176 i.e =SUM(J3:J10)
:
:
K5488
up to K5488 (No numbers in sequence, all different numbers)
The largest number appearing in K is 1 400 000.
I need in Column M: The prime factors of each number in K
e.g. K8 is 6384 then M8 should be 2,2,2,2,3,7,19
k9 is 2598 then M9 should be 2,3,433 etc.
I found the following code by John Coleman on your site (Mar 28) which tested well, but seeing I have no programming knowledge, I don't know how to modify it to use in my columns K & M setup.
Here's the sample code:
Function Factor(ByVal n As Long, Optional FirstTrial As Long = 2) As String
Dim i As Long
Dim t As Long
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If n Mod t = 0 Then
rest = Factor(n / t, t)
If rest <> "1" Then
s = t & "," & rest
End If
Factor = s
Exit Function
Else
If t = 2 Then t = 3 Else t = t + 2
End If
Loop
'if we get here:
Factor = n
End Function
Function PrimeOrFactor(n As Long) As String
Dim s As String
s = Factor(n)
If n = 1 Then
PrimeOrFactor = "Neither"
ElseIf (s) = Trim(n) Then
PrimeOrFactor = "Prime"
Else
PrimeOrFactor = s
End If
End Function
Tested like:
Sub test()
Dim i As Long
For i = 1 To 20
Cells(i, 1) = i
Cells(i, 2) = PrimeOrFactor(i)
Next i
End Sub
The function you provided is a udf (user defined function) to be used in your worksheet.
If you put the functions you provided in a normal code module, you can enter the following in your worksheet in M8:
=Factor(K8)
and copy that function down to your desired range.

Find all cell containing a substring and add them

I want to add all cells that contains the word "WAGES" If a cell in column G contains the word "WAGES" the amount(column j) will be displayed. If there's 2 or more cells containing "WAGES" then their respective amounts will be added. Here's my code:
Dim i As Integer
Dim x As String, name As String
Dim a As Double, b As Double
x = "WAGES"
i = 3
Do Until Sheets("SHIPNET").Cells(i, 7) = ""
name = Sheets("SHIPNET").Cells(i, 7)
If InStr(1, name, x, 1) Then
a = Sheets("SHIPNET").Cells(i, 10).Value
i = i + 1
End If
If InStr(1, name, x, 1) Then
b = Sheets("SHIPNET").Cells(i, 10).Value
i = i + 1
End If
i = i + 1
Loop
Sheets("MACRO TEMPLATE").Cells(5, 3) = a + b
My code is only limited to 2 cell that contains "WAGES". Is there anyway to make it dynamic instead of finding 2 cells only?
In the picture's case, -28,622.20 and -50,372.64 will be added.
Why not use a SUMIF with wildcards?
One line of code to replace the whole thing.
Sheets("MACRO TEMPLATE").Cells(5, 3) = worksheetfunction.SumIf(Sheets("SHIPNET").Range("G:G"),"*WAGES*",Sheets("SHIPNET").Range("J:J"))

Simulating a binomial distribution

I want to simulate a binomial distribution where the price of something can only go up or down with the probability of p that is 50% this time.
My variables:
S=100 (the basic value)
u=1,1 (how much the value goes up in each experiment if it goes up)
d=1/u (how much the value goes down in each experiment if it goes down)
p=0.5 (probability)
n=400 (number of experiments)
I did not declare these variables, because I want to read these values from specific cells.
My code (for the first step):
Sub BINOM()
S = Range("L4").Value
u = Range("M4").Value
d = Range("N4").Value
p = Range("O4").Value
n = Range("P4").Value
v = Rnd()
If v > p Then
Range("B2").Value = S * u
Else
Range("B2").Value = S * d
End If
End Sub
The result of the second experiment (that should be written in the B3 cell) has to be calculated from the result of the first experiment and so on but not with using the same random number.
I'll try my best but I just removed Excel in favor of Calc which doesn't support the same type of language as far as I can tell.
Sub BINOM()
Dim intCounter, v
S = Range("L4").Value
u = Range("M4").Value
d = Range("N4").Value
p = Range("O4").Value
n = Range("P4").Value
Range("B1").Value = s
For intCounter = 2 to n
'//If this creates an error then just remove it.
'//It should keep the same random number from appearing over and over.
Randomize
'//Create new Random number in v
v = Rnd()
If v > p Then
Range("B" & intCounter).Value = Range("B" & (intCounter - 1)).Value * u
Else
Range("B" & intCounter).Value = Range("B" & (intCounter - 1)).Value * d
End If
Next intCounter
End Sub
Let me know if that works out for you or if any errors appear. Updated to base each cell from data given of previous cell.

Resources