I need to create a Unique-ID (string) for each record as I am developing an application which allows users to access a unique URL like:
http://URL.com/BXD31F
The code below works to create the URLIDs:
Public Function getURLID(ID As Double) As String
Randomize
Dim rgch As String
rgch = "23456789ABCDEFGHJKLMNPQRSTUVWXYZ"
Dim i As Long
For i = 1 To 5
getURLID = getURLID & Mid$(rgch, Int(Rnd() * Len(rgch) + 1), 1)
Next
End Function
How can I ensure that the URLID created is unique? Do I need to query the database to ensure it has not been generated before? The table has 5 million records. A dlookup query would exceed the limitations of my MSAccess database.
I have considered using the timestring to generate the URLID:
Format(Now, "yymmddhhmmss")
However, I only want a simple 5 character string.
How can I ensure that the URLID created is unique?
You can't. And it won't be. Look into cryptographically secure hashing algorithms... and even those are never "secure" forever. Note, hashing is something for which VBA has absolutely zero built-in support, but you can leverage .NET for that.
Another option could be to get the OS to generate Globally Unique IDentifiers (GUID); these would be unique, ...but much longer than a handful of characters.
Good luck!
Ensuring that a string is unique with VBA could be done somehow differently. E.g., take the date time, which is unique every second and give it:
format(now, "YYMMDDHHNS")
As far as it would be too obvious, consider changing it a bit. E.g., remove a random contant number from the datetime, let's say 181387 (as it is a prime number) and pass convert it to a hex. Then it would be quite ok:
Function UniqueString() As String
Const someNumber = 181387 'it is a prime number
UniqueString = Hex(Format(Now, "YYMMDDHHNS") - someNumber)
End Function
The above does not seem to work for 32-bit machines. Thus, you may consider splitting the parts of the date to separate numbers and hex-ing them separately:
Function UniqueString32() As String
Const primeNumber = 23
Application.Wait Now + #12:00:02 AM# 'waiting 2 seconds
UniqueString32 = Hex(Format(Now, "YY")) _
& Hex(Format(Now, "MM")) _
& Hex(Format(Now, "DD")) _
& Hex(Format(Now, "HH")) _
& Hex(Format(Now, "NS") - primeNumber)
End Function
Just make sure there is at least 1 second before calling the function, calling it in the same time zone. Plus, it is a good idea to think about the daylight saving time in advance. In general, it is not a great idea, there would be quite a lot of problems popping up, but for vba and ms-access it would be ok.
I managed to solve my own problem. We need to check to see if the URLID already exists in the table. The challenge is that the URLID is not written into the table until the query has completely executed. Using 6 of the possible 24 characters will give us about 191 million possibilities (24 to the power of 6). As we only need to create 5 million IDs, there is a small chance for duplicate records.
This is how I did it:
Step 1 - Generate Random a URLID for the 5 million rows using the original code
Step 2 - Identify duplicates and update to null using query below
UPDATE URLIDs SET URLIDs.URL = Null
WHERE (((URLIDs.URL) In (SELECT [URL] FROM [URLIDs] As Tmp GROUP BY [URL] HAVING
Count(*)>1 )));
Step 3 - Generate new URLID for the nulls identified in Step 2. This time, checking to see if they already exist in the table. See code below:
Public Function getURLID(roll As Double) As String
Randomize
Dim rgch As String
rgch = "ABCDEFGHJKLMNPQRSTUVWXYZ"
Dim i As Long
For i = 1 To 6
getURLID = getURLID & Mid$(rgch, Int(Rnd() * Len(rgch) + 1), 1)
Next
Do Until URLIDExists(getURLID) = False
getURLID = ""
For i = 1 To 6
getURLID = getURLID & Mid$(rgch, Int(Rnd() * Len(rgch) + 1), 1)
Next
Loop
End Function
Function below used to see if URL exists
Public Function URLIDExists(URLID As String) As Boolean
Dim RS1
Dim strQuery As String
strQuery = "SELECT * from [URLIDs] where [URL]='" & URLID & "'"
Set RS1 = CurrentDb.OpenRecordset(strQuery)
If RS1.RecordCount > 0 Then
URLIDExists = True
Else
URLIDExists = False
End If
Set RS1 = Nothing
End Function
I repeated steps 2 and 3 until there are were no more duplicates. Each time checking against the existence of the already confirmed URLID. Eventually there will be no more duplicate URLIDs.
Related
I am working on a visual basic project. I have a mdb database connected to my project. I want to add a SELECT query that finds the results which are in array that i give it on my program
I have tried to write a statement like that:
SELECT kodu, adi_soyadi, sectigi_ders_say
FROM ogrenciler
WHERE kodu IN ?
But it does not work. In my page codes I have an array and I want to find results from "ogrenciler" table where the "kodu" is in my array.
Well, you could send that array to a temp table in Access, but that would prevent more then one user using the software at the same time. (or you could add some user name to the temp table. However, if the array of choices is small, say about max 50, then you can create the sql string.
eg:
Dim MySQL As String = "SELECT * from tblHotels WHERE ID IN("
Dim IdList(5) As Integer
Dim i As Integer
For i = 1 To 5
IdList(i) = i
Next
Dim MyList As String = ""
For i = 1 To 5
If MyList <> "" Then MyList = MyList & ","
MyList = MyList & IdList(i)
Next
MySQL = MySQL & MyList & ")"
Using MyCon2 As New OleDbConnection(My.Settings.OLESQL)
Dim da As New OleDbDataAdapter(MySQL, MyCon2)
Dim rstDat As New DataTable()
da.Fill(rstDat)
For i = 0 To rstDat.Rows.Count - 1
Debug.Print(rstDat.Rows(i).Item("HotelName"))
Next ' etc etc. etc.
End Using
So you can use the SQL format of:
SELECT * FROM tblHotels where ID IN (1,2,3)
And thus build up the "list". The only downside to this approach is that the sql string is limited to 2000 characters. So, if your list is larger then say 50 or so items, then you have to adopt a different approach.
This is a follow-up concern. I need to convert numbers to words in vb.net using only select case. WE ARE NOT allowed to use functions, if else , loops, subs and arrays. What I did is divide each number places (ones, tens, hundreds, and so on). Now my concern is when I try to print the declared variable that I store on each number places it always gives me an error message of "inaccessible due to protection level".
Can anyone give me a tip on how I will store them and print it once? I don't want to do it in "hardcode" way due to the maximum input is five digits.
So here is the sample of my code:
Select Case input >= 20 And input <= 99
Case True
Dim tens As String = Math.Floor(input \ 10)
Dim ones As String = Math.Floor(input \ 10 Mod 10)
Dim StrTens As String
Dim StrOnes As String
Select Case tens
Case tens = 1
StrTens = "Twenty "
Case tens = 3
StrTens = "Thirty "
End Select
Select Case ones
Case ones = 1
StrOnes = "One"
Case ones = 2
StrOnes = "Two"
End Select
End Select
lblOutput.Text = StrTens + StrOnes
There are a number of issues with your code. This seems to work. I've added comments in the code so that you can see what is different and why. Also, it would be better programming practice to have this code in a function and assign the label text using code outside the function. Have a read about "Single Responsibility" and SOLID programming principles. Here you go.
'this in my example just makes sure that all the
'variables are declared. If you have declared them
'outside this code, you should be able to delete them
'They need to be declared outside of the Select..Case
'statements, otherwise they would only be visible inside
'the Select..Case statements
Dim tens, ones As Integer
Dim strTens As String = ""
Dim strOnes As String = ""
Select Case input >= 20 And input <= 99
Case True
'This is a simplified version of your code.
'Math.floor returns a result that is a Double
'type, so strictly speaking you should convert it
'to an integer type
tens = CInt(Math.Floor(input \ 10))
'your original calculation wil result in an
'incorrect result for example if input=22
'32 divided by 10 is 3.2. 3.2 mod 10 will
'be 3.2
'The method below returns the correct result
ones = CInt(Math.Floor(input Mod 10))
Select Case tens
Case 2
strTens = "Twenty "
Case 3
strTens = "Thirty "
End Select
Select Case ones
Case 1
strOnes = "One"
Case 2
strOnes = "Two"
End Select
'Using + to concatenate strings is a bad idea
'because + will attempt to perform and arithmetic
'add operation and if either string is not purely
'digits, I think you will get an "InvalidCastException"
'when you try to run it. Using & indicates your
'intention to concatenate them not add numbers
test = strTens & " " & strOnes
'You didn't specify what to do if the number is outside
'you range of 20-99. This is a poor way of doing that,
'but simple enough for your needs for now
Case Else
MessageBox.Show("Number must be >19 and <100")
test = ""
End Select
i've recently have made a random 8digit ID Generator on my Form. But i was recommended to create a running alphanumeric number instead of the 8 random digit generator..
The file im currently using is a saved template for me to send to users. so i was wondering if it's possible to have a running alphanumber number everytime they opened the file. i just couldnt think of any way to "store a main cell where it can keep +1 on the previous code" because this template is not saved everytime i open but is to send to other users..
Or is there anyway where the file can check on my database for the next number to be sent and generate it on the form? Thanks..
Here is currently what i have for the 8 digit generator
Private Sub Workbook_Open()
' Called every time you open the excel document
Dim myRandNumber As Long
Randomize
myRandNumber = CLng(Rnd() * 99999999) ' CLng converts the floating point number to a long integer
Dim rowNum As Integer
Dim colNum As Integer
rowNum = 6
colNum = 4
With ThisWorkbook.Sheets(MySheetName).Cells(rowNum, colNum)
If (.Value = "") Then
.Value = myRandNumber
End If
End With
End Sub
Just map digits or random numbers to characters, e.g. Chr(65) is "A", etc. So the range is 65-90 for upper-case letters (English/Latin without diacritics)
At it's simplest, this would give a random letter (given limitations of Excel's/VBA's randomness, of course):
Chr(WorksheetFunction.RandBetween(65,90))
The range for numerals is 48-57.
So develop a simple algorithm that chooses whether each is a digit or a character, and assign using the Chr function then joining them.
i just couldnt think of any way to "store a main cell where it can keep +1 on the previous code"
Store it in a Name or a cell on a hidden worksheet.
Or is there anyway where the file can check on my database for the next number to be sent and generate it on the form?
Possible, yes, but too broad a question. You can use VBA to connect to database using several methods like this or see here for more possibilities. This will require more robust coding & error-handling -- what happens if user can't connect to the database, isn't on the network, etc...
you can do this by creating a userdefined function like
Function createCode(codelength As Integer) As String
Dim x As Integer, iTemp As Integer
Dim strTemp As String
Dim i As Integer
Do Until i = codelength
iTemp = Int(Rnd * 99)
If iTemp >= 65 And iTemp <= 90 Then
strTemp = strTemp & Chr(iTemp)
i = i + 1
ElseIf iTemp >= 97 And iTemp <= 122 Then
strTemp = strTemp & Chr(iTemp)
i = i + 1
ElseIf iTemp >= 48 And iTemp <= 57 Then
strTemp = strTemp & Chr(iTemp)
i = i + 1
End If
Loop
createCode = strTemp
End Function
that should be called like,
Sub caller()
MsgBox createCode(8)
End Sub
I'm going to post this as an answer, because it is (IMHO) the best answer to the problem, even if it isn't the best answer to the question.
Use a GUID.
That will mean you are almost certainly guaranteed to not have a collision between generated IDs (unless you have several billion users opening copies of your workbook once every second for many years), and it is easy to do within Excel:
Private Sub Workbook_Open()
'Update sheet name and range address as appropriate
With ThisWorkbook.Sheets("Sheet1").Range("D6")
If IsEmpty(.Value) Then
.Value = Left(CreateObject("Scriptlet.TypeLib").GUID, 38)
End If
End With
End Sub
I'm having trouble turning my thought process into tangible code and honestly I'm not sure where to start with the code. I have a data set with two applicable columns, for the sake of simplicity we'll say A and B. A contains a list of three initials followed by a number, ex. JFD3, JFD2, JFD6, EUW1, YMG2, YMG3. Column B has a value. I need to find the range of the highest to lowest values for each set of initials, which has me thinking a max - min solution. The list of initials isn't necessarily in order, and there could be one set of initials(with a net variance of 0, which is OK), or up to 8 sets of initials, with the numbers not necessarily being consecutive. I was thinking some sort of Match(Left(3)) but i don't think that would encompass everything.
Any ideas on where to start would be much appreciated. I'll be happy to clarify if theres any questions.
You can use dictionaries from the Scripting Runtime to do this easily. Use two of them with the initials as the keys, one holding the minimum values found and the other holding the maximum values found.
Add a reference to the Microsoft Scripting Runtime (Tools->Add reference..., then check the box next to "Microsoft Scripting Runtime") or late bind (see instructions below). Something like this should do the trick, assumes initials in column 1, values in column 2, no headers:
Private Sub MinMax()
Dim mins As Dictionary
Dim maxes As Dictionary
Dim sheet As Worksheet
Set sheet = ActiveSheet
Set mins = New Dictionary
Set maxes = New Dictionary
Dim row As Long
For row = 1 To sheet.UsedRange.Rows.Count
Dim key As Variant
Dim val As Integer
key = sheet.Cells(row, 1).Value2
If Len(key) >= 3 Then
key = Left$(sheet.Cells(row, 1).Value2, 3)
val = sheet.Cells(row, 2).Value2
If Not mins.Exists(key) Then
mins.Add key, val
Else
If mins(key) > val Then mins(key) = val
End If
If Not mins.Exists(key) Then
maxes.Add key, val
Else
If maxes(key) < val Then maxes(key) = val
End If
End If
Next row
For Each key In mins.Keys
Debug.Print key & ": Min = "; mins(key) & " Max = "; maxes(key)
Next key
End Sub
To use late binding, the code is exactly the same with these exceptions. Instead of declaring mins and maxes as Dictionary, declare them as Object:
Dim mins As Object
Dim maxes As Object
And instead of setting them as New Dictionary, use CreateObject:
Set sheet = ActiveSheet
Set mins = CreateObject("Scripting.Dictionary")
Set maxes = CreateObject("Scripting.Dictionary")
Use a Pivot Table. Put your Column A field* in the Row Labels, then put column B in the Values twice. Change one from Sum to Min, and the other from Sum to Max.
* Not sure if you need to group by JFD for all JFDx or by each JFDx. If you need them grouped by the 3 initials, make a column C =left("A1",3), then use that in your
An approach to this could be:
Sort the data in the range A-B by A in alphabetical order. To do this, you can record a macro while doing this action and edit the code to make it dynamically working every time. This is required to make the below solution work, more performing for many other kinds of similar approaches.
Use While blocks to run the solution. I let you take the time to build and test a working code, but this is the idea:
startSubset = 2 '<-- we start getting the key from row 2
'build the key to define the subset
keyStart = 1
currentKey = ""
Do While Not IsNumeric(Right(Left(Range("A" & startSubset),keyStart),1))
'while the last char of the key is not numeric, let's add it to the key
currentKey = currentKey & Right(Left(Range("A" & startSubset),keyStart),1)
keyStart = keyStart + 1
Loop
After the above, the key is stored in the variable currentKey. It will be JFD if the first cell is JFD213, etc. Hence, you loop until the end of this subset storing max and min in two variables:
min = 0
max = 0
Do While Left(Range("A" & startSubset),Len(currentKey)) = currentKey
If Range("B" & startSubset) < min Then min = Range("B" & startSubset)
If Range("B" & startSubset) > max Then max = Range("B" & startSubset)
startSubset = startSubset + 1
Loop
Once this is done, you just need to cast the values into a collection, for example:
myObs.Add(currentKey)
myObs.Add(min)
myObs.Add(max) '<-- you will get something like myObs = ("DJF", 0, 100)
Then cast this object into a bigger collection:
allValues.Add(myObs) '<-- at the end you will have something like this:
'allValues = [("DJF",0,100), ("ABC", 1, 75), ...]
and re-set the values to let them continue:
currentKey = ""
keyStart = 1
All the above, should be run in a While loop that will break when the data are over.
Please note the above code cannot work standing-alone, but it's rather a possible approach to the problem that you will need to re-work on your data to make it work in real life.
I've been messing around with VBA in Excel a bit recently; and as a small project for myself, I'm trying to create a "draw names from a hat" sort of macro.
I began by generating a random number, and then choosing which entry from a Table (i.e. ListObject) would be selected using a case statement. The problem with this is that it only works of the number of Table entries is always the same.
So my question (probably a ridiculous one) is: is it possible at all to generate a dynamic 'Select Case' block, where the number of cases on the block is based on the number of entries in the Table?
Thanks.
-Sean
Edit: To clarify: what I am trying to do, exactly, is this:
I generate a random number, i, from 1 to n=10*(number of Table entries). After this, I want to display, in a cell, one of the table entries based on the random number.
Ideally, the code would work similarly to this:
if i = 1 to 10 then choose event 1
if i = 11 to 20 then choose event 2
if i = 21 to 30 then choose event 3
...
if i = (n-9) to n then choose event (n/10)
I hope this helps to clarify the goal of the code.
From our comments here is something you can use:
Sub random()
Dim used_rows As Integer
Dim random As Integer
Dim cell_array() As Integer
used_rows = Sheet1.UsedRange.Rows.Count
ReDim cell_array(used_rows)
For i = 1 To used_rows
cell_array(i - 1) = Cells(i, 1)
Next
random = Int(Rnd * (used_rows))
MsgBox cell_array(random)
End Sub
You can go ahead and change MsgBox to whatever you like, or set like Cell(1,4).Value = cell_array(random), or however you'd like to proceed. It will be based off the number of rows used. Though depending on how you implement your spreadsheet the code might have to be changed a bit.
Here's the update code from the suggestions from the comments. Also remember to use Randomize() in your form initialization or WorkBook Open functions.
Sub random()
Dim used_rows As Integer
Dim random As Integer
'Multiple ways to get the row count, this is just a simple one which will work for most implementations
used_rows = Sheet1.UsedRange.Rows.Count
random = Int(Rnd * (used_rows))
'I use the variable only for the reason that you might want to reference it later
MsgBox Cells(random, 1)
End Sub
This assumes that by "table" you mean "Table with a capital T", known in VBA as a ListObject:
Sub PickRandomTens()
Dim lo As Excel.ListObject
Dim ListRowsCount As Long
Dim RandomNumber As Long
Dim ListEvent As String
Dim Tens As Long
Set lo = ActiveSheet.ListObjects(1)
ListRowsCount = lo.DataBodyRange.Rows.Count
RandomNumber = Application.WorksheetFunction.RandBetween(10, ListRowsCount * 10)
ListEvent = lo.ListColumns("Data Column").DataBodyRange.Cells(Int(RandomNumber / 10))
MsgBox "Random number: " & RandomNumber & vbCrLf & _
"Event: " & ListEvent
End Sub