I want to write VBA script and add it to the button to get an random unique ID.
The sample format:
F-B829IB-BKC1
F-QLM9I4-EFCY
It should start with "F" ; "-" ; random 6 digits/letters ; "dash" ; random 4 digits/letters
Thanks in advance for your assistance.
Here is a function that you might be able to apply to your needs:
Function RandID() As String
Dim pool As String
Dim id As String
Dim i As Long, n As Long
pool = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
n = Len(pool)
id = "F-"
For i = 1 To 11
If i = 7 Then
id = id & "-"
Else
id = id & Mid(pool, Application.WorksheetFunction.RandBetween(1, n), 1)
End If
Next i
RandID = id
End Function
Typical output: F-I8FTLX-3E81.
These IDs are on the short side. Uniqueness isn't guaranteed, especially if a large number of IDs are to be generated. The total number of IDs is 36^10, so you are probably safe for small-scale use.
Related
I am using a VBA user form to audit the part numbers put onto a roller cart and the corresponding slot number. I want the users to be able to use a bar code scanner to scan parts and slot numbers in any order, so I just need to determine the maximum slot number that they scan, no matter which order they scan the parts and slots in. That means being able to search an array for a maximum slot value, which I have done, and redimension the part number array to it. This code works perfectly until the part number array size hits ten, then the if statement that I used to determine the maximum slot number is no longer triggered, meaning my part number array cannot be redimensioned to the new maximum value and I get a 'Subscript out of Range' error. Any ideas why this might be happening? I'm at a loss. Any help is greatly appreciated!
P.S. Some public variables shown below are not used in this section of the code. Also, this is the code for the entire continue button, but focus is really only on the code before the first unload statement.
`
Public Item As Variant
Public SlotNum(), clicked, I, max, c, p, z, ECounter As Integer
Public PartNum(), TSN, Beacon As String
Private Sub BTNNextSlot_Click()
If TBSlotNum.Value <> 0 And TBPartNum.Value <> "" Then
p = 0
z = 0
Do While p = 0
clicked = clicked + 1
ReDim Preserve SlotNum(clicked)
SlotNum(clicked) = TBSlotNum.Value
For Each Item In SlotNum
If SlotNum(Item) > max Then
max = SlotNum(Item)
End If
Next Item
ReDim Preserve PartNum(max)
PartNum(TBSlotNum.Value) = TBPartNum.Value**
Unload Step2
For Each Item In PartNum
If IsEmpty(Item) Then
ECounter = ECounter + 1
End If
Next Item
If c = UBound(PartNum) And ECounter = 0 Then
p = 1
Else: p = 0
Load Step2
Step2.Show
End If
Loop
Else: MsgBox "Complete the above fields"
End If
End Sub
`
there. I made this code that replaces a character for two number (e.g. 0 = 10; 1 = 11; 2 = 12; ...) and everything works fine except for the first element (the zero element). So, if I put "010a4" string on cell A1 and use my formula "=GENERATECODE(A1)", my expected return value is "1011102014" but I've got a "110111102014" string. So, only zero value occur this error and I can't figured out why. Any thoughts?
My code:
Function GENERATECODE(Code As String)
Dim A As String
Dim B As String
Dim i As Integer
Const AccChars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const RegChars = "1011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071"
For i = 1 To Len(AccChars)
A = Mid(AccChars, i, 1)
B = Mid(RegChars, 2 * i - 1, 2)
Code = Replace(Code, A, B)
Next
GENERATECODE = Code
End Function
Your problem is that your code first change each 0 to 10 then each 1 to 11. So each 0 give you 10 then 110.
If you want to keep the same kind of algorithm (which might not be a good choice), you need to change AccChars and RegChars so that a character is never replaced by a string that can give a character found later on the AccChars String. In your case just replace Const AccChars = "012 ... per Const AccChars = "102 ... and Const RegChars = "101112 ... per Const RegChars = "111012 ...
But it might be better to change your algorithm altogether. I would first suggest to not use in place editing of the string, but rather to use 2 Strings.
In addition to being incorrect, your current code is inefficient since it involves scanning over the code string multiple times instead of just once. Simply scan over the string once, gathering the substitutions into an array which is joined at the end:
Function GENERATECODE(Code As String) As String
Dim codes As Variant
Dim i As Long, n As Long
Dim c As String
n = Len(Code)
ReDim codes(1 To n)
For i = 1 To n
c = Mid(Code, i, 1)
Select Case c
Case "0" To "9":
codes(i) = "1" & c
Case "a" To "z":
codes(i) = Asc(c) - 77
Case "A" To "Z":
codes(i) = Asc(c) - 19
Case Else:
codes(i) = "??"
End Select
Next i
GENERATECODE = Join(codes, "")
End Function
Example:
?generatecode("010a4")
1011102014
The point of the two offsets is that you want "a" to map to 20 and "A" to map to 46. Note Asc("a") - 77 = 97 - 77 and Asc("A") - 19 = 65-19 = 46.
im having a hard time getting a function working. I need to search message.text for each "," found, for each "," found I need to get the number position of where the "," is located in the string. For example: 23232,111,02020332,12 it would return 6/10/19 where the "," are located (index of). My code finds the first index of the first , but then just repeats 6 6 6 6 over, any help would be appreciated thanks.
Heres my code:
For Each i As Char In message.Text
If message.Text.Contains(",") Then
Dim data As String = message.Text
Dim index As Integer = System.Text.RegularExpressions.Regex.Match(data, ",").Index
commas.AppendText(index & " ")
End If
Next
You can try it this way; instantiate a Regex object and increment each time the position from which you start the matching (this possibility is not available with the static method Match).
Dim reg As New System.Text.RegularExpressions.Regex(",")
Dim Index As Integer = reg.Match(data).Index
Do While Index > 0
commas.AppendText(index & " ")
Index = reg.Match(data, Index + 1).Index
Loop
p.s the returned indices are zero-based.
Just use the Regex.Matches method
Dim message As String = "23232,111,02020332,12"
Dim result As String = ""
For Each m As Match In Regex.Matches(message, ",")
result &= m.Index + 1 & " "
Next
I should also add that indexes are 0 based (which is why +1 is added to m.Index). If you later need these values to point to the position of a particular comma, you may be off by 1 and could potentially try to access an index larger than the actual string.
I have been working on a project which is getting a serial number in the context of "J39303", But sometimes there are multiple serials but every time I can guarantee each serial will be 6 letters long, so for example,
J848407888488393 - here is 3 serials just without the J as the start, I want to be able to split it up into 3 separate values, J84840, 78884, 88393,
I have looked at right, mid and left but because the position changes I cannot use these, I am now looking at a For loop to group each 5 characters but have had no luck,
Could someone post me in the right direction,
Thanks!!
This should do it:
Sub mysplit()
Const SNLength As Integer = 5
Dim SNs As String
SNs = "J848407888488393"
Dim SerialNumber As String
Dim index As Integer
If Left(SNs, 1) = "J" Then SNs = Mid(SNs, 2)
index = 1
Do While index < Len(SNs)
SerialNumber = Mid(SNs, index, SNLength)
MsgBox "J" + SerialNumber
index = index + SNLength
Loop
End Sub
Am getting data from database and store in dataset.dataset contains list of phone numbers.
i want to find out the length of each and every phone numbers. if it is length ten means add it in one datatable. Or length greater than 10 means get the 10 char from the right side of the phone number and stored it on the same datatable.Here is my code.when i debug the code i get only 8000 some thing rows.but originally the dataset contains 40,700 row values. after the
datatable reaches 8000 rows am getting error
my code
-------
ada.Fill(ds, "reports.renewal_contact_t ")
ds.Tables(0).DefaultView.RowFilter = " PHONE NOT like'0'"
dt = ds.Tables(0)
For Each q In dt.Rows
chkphone = q("PHONE").ToString
chkdphone = Regex.Replace(chkphone, "[^\d]", "")
'MessageBox.Show(chkdphone)
If (chkdphone.Length = 10) Then
Dim anyRow As DataRow = dt2.NewRow
anyRow(0) = chkphone.ToString
dt2.Rows.Add(anyRow)
ElseIf (chkdphone.Length >= 10) Then
rsltstring = chkdphone.Substring(chkdphone.Length, -10)
Dim anyrow1 As DataRow = dt2.NewRow
anyrow1(0) = rsltstring.ToString
dt2.Rows.Add(anyrow1)
Else
End If
Next
new_ds.Tables.Add(dt2)
ComboBox1.DataSource = new_ds.Tables(0)
ComboBox1.DisplayMember = "PHONE"
Error
-----
length cant be less than zero parameter name length
You can't use a negative length in the Substring method. Subtract ten from the length to get the starting point of the string that you want:
rsltstring = chkdphone.Substring(chkdphone.Length - 10, 10)
As you want the rest of the string from that point, the second parameter is actually not needed:
rsltstring = chkdphone.Substring(chkdphone.Length - 10)