Random number creating - vba

I got some help from one, and the code works perfectly fine.
What im looking for, is an explanation of the code, since my basic VBA-knowledge does not provide me with it.
Can someone explain what happens from "Function" and down?
Sub Opgave8()
For i = 2 To 18288
If Left(Worksheets("arab").Cells(i, 12), 6) = "262015" Then
Worksheets("arab").Cells(i, 3) = "18" & UniqueRandDigits(5)
End If
Next i
End Sub
Function UniqueRandDigits(x As Long) As String
Dim i As Long
Dim n As Integer
Dim s As String
Do
n = Int(Rnd() * 10)
If InStr(s, n) = 0 Then
s = s & n
i = i + 1
End If
Loop Until i = x + 1
UniqueRandDigits = s
End Function

n = Int(Rnd()*10) returns a value between 0 and 9, since Rnd returns a value between 0 and 1 and Int converts it to an integer, aka, a natural number.
Then If InStr(s, n) = 0 checks if the random number is already in your result: if not, it adds it using the string concatenation operator &.
This process loops (do) until i = x + 1 where x is your input argument, so you get a string of length x. Then the first part just fills rows with these random strings.
N.B. : I explained using the logical order of the code. Your friend function UniqRandDigits is defined after the "business logic", but it's the root of the code.

The code loops from row 2 to 18288 in Worksheet "arab". If first 6 characters in 12th column are "262015", then in 3rd column macro will fill cell with value "18" followed by result of function UniqueRandDigits(5) which generates 5 unique digits (0-9).
About the UniqueRandDigits function, the most important is that Rnd() returns a value lesser than 1 but greater than or equal to zero.
Int returns integer value, so Int(Rnd() * 10) will generate a random integer number from 0 to 9.
If InStr(s, n) = 0 Then makes sure than generated integer value doesn't exist in already generated digits of this number, because as the function name says, they must be unique.

Related

Add integer to another integer in vb.net?

How can I add an integer to another integer in vb.net?
This is what I need to do:
Given integer: 2187 ->
Converted integer: 2018
I need to add a 0 in between the first and second number, and drop the last digit. This will give me the year.
Here is the code that I have:
Protected Function GetYear(ByVal term As Integer) As Integer
Dim termYear As String = Convert.ToString(term)
termYear.Substring(0, 2)
termYear.Insert(1, "0")
Dim convertedYear As Integer
Int32.TryParse(termYear.ToString, convertedYear)
convertedYear = convertedYear / 10
Return convertedYear
End Function
In general strings are immutable. So you'd have to create a new string out of the addition of substrings. Check this possible solution.
Function GetYear(ByVal term As Integer) As Integer
Dim termYear As String = Convert.ToString(term, Globalization.CultureInfo.InvariantCulture)
Dim result As String = termYear.Substring(0, 1) + "0" + termYear.Substring(1, 2)
Return Int32.Parse(result)
End Function
Strings are immutable, when you do any changes with one of their method, you need to get the returned string.
termYear = termYear.Insert(1, "0")
This question deserves a math based solution. The below code specifies the zero insertion point relative to the number's right side instead of the left as stated in the problem statement. So for a 4 digit number the insertion point is 3 versus 2. It also allows you to change the insertion point.
Private Function GetYear(ByVal term As Integer, Optional zeroDigitPosition As Integer = 3) As Integer
If zeroDigitPosition > 0 Then
Dim divisor As Integer = 1
For i As Integer = 1 To zeroDigitPosition - 1
divisor *= 10
Next
Dim ret As Integer = term \ 10 ' drop one's place digit, remaining digits shift to right
Dim rightShiftedDigits As Integer = ret Mod divisor
Dim remainder As Integer = Math.DivRem(ret, divisor, rightShiftedDigits)
' shift the remainder to the left by divisor * 10
' (remember first right shift invplved \ 10) and add
' rightShiftedDigits to yield result
Return (remainder * divisor * 10) + rightShiftedDigits
Else
Throw New ArgumentOutOfRangeException("zeroDigitPosition must be greater then zero")
End If
End Function

signed result of Val function in VBA

I use vba in ms access,and found that ,if my parameter greater than 0x8000
less than 0x10000, the result is minus number
eg. Val("&H8000") = -32768 Val("&HFFFF")= -1
how can i get the unsigned number?
thanks!
There's a problem right here:
?TypeName(&HFFFF)
Integer
The Integer type is 16-bit, and 65,535 overflows it. This is probably overkill, but it was fun to write:
Function ConvertHex(ByVal value As String) As Double
If Left(value, 2) = "&H" Then
value = Right(value, Len(value) - 2)
End If
Dim result As Double
Dim i As Integer, j As Integer
For i = Len(value) To 1 Step -1
Dim digit As String
digit = Mid$(value, i, 1)
result = result + (16 ^ j) * Val("&H" & digit)
j = j + 1
Next
ConvertHex = result
End Function
This function iterates each digit starting from the right, computing its value and adding it to the result as it moves to the leftmost digit.
?ConvertHex("&H10")
16
?ConvertHex("&HFF")
255
?ConvertHex("&HFFFF")
65535
?ConvertHex("&HFFFFFFFFFFFFF")
281474976710655
UPDATE
As I suspected, there's a much better way to do this. Credits to #Jonbot for this one:
Function ConvertHex(ByVal value As String) As Currency
Dim result As Currency
result = CCur(value)
If result < 0 Then
'Add two times Int32.MaxValue and another 2 for the overflow
'Because the hex value is apparently parsed as a signed Int64/Int32
result = result + &H7FFFFFFF + &H7FFFFFFF + 2
End If
ConvertHex = result
End Function
Append an ampersand to the hex literal to force conversion to a 32bit integer:
Val("&HFFFF" & "&") == 65535
Val("&H8000&") == +32768
Don't use Val. Use one of the built-in conversion functions instead:
?CCur("&HFFFF")
65535
?CDbl("&HFFFF")
65535
Prefer Currency over Double in this case, to avoid floating-point issues.

Get Index of last active columns per Row in Excel using Open XML

How do i get the Index of the last active column in a row using Open Xml
i have this for row 1.
Dim activeCells As IEnumerable(Of DocumentFormat.OpenXml.Spreadsheet.Cell) = row.Descendants(Of DocumentFormat.OpenXml.Spreadsheet.Cell)().Where(Function(c) Not String.IsNullOrEmpty(c.InnerText))
Dim cell As DocumentFormat.OpenXml.Spreadsheet.Cell = activeCells.LastOrDefault()
Dim CellRef As String = cell.CellReference
This gives D1", but what i want is the index in this case "4". how do i go about this?
To convert the cell reference to a column index you could use something like the following (I've converted the code from the answer here which you've inspired me to write :)).
Private Shared Function GetColumnIndex(cellReference As String) As System.Nullable(Of Integer)
If String.IsNullOrEmpty(cellReference) Then
Return Nothing
End If
'remove digits
Dim columnReference As String = Regex.Replace(cellReference.ToUpper(), "[\d]", String.Empty)
Dim columnNumber As Integer = -1
Dim mulitplier As Integer = 1
'working from the end of the letters take the ASCII code less 64 (so A = 1, B =2...etc)
'then multiply that number by our multiplier (which starts at 1)
'multiply our multiplier by 26 as there are 26 letters
For Each c As Char In columnReference.ToCharArray().Reverse()
columnNumber += mulitplier * (CInt(c) - 64)
mulitplier = mulitplier * 26
Next
'the result is zero based so return columnnumber + 1 for a 1 based answer
'this will match Excel's COLUMN function
Return columnNumber + 1
End Function
Note: the VB might not be idiomatic as I used the Telerik Converter to convert it from C# to VB.

Random numbers in array without any duplicates

I'm trying to randomize an array from numbers 0 to 51 using loops but I just cannot seem to pull it off. My idea was that
Generate a Random Number
Check if this random number has been used by storing the previous in an array
If this random number has been used, generate new random number until it is not a duplicate
If it's not a duplicate, store it
My attempt:
Dim list(51) As Integer
Dim templist(51) As Integer
For i As Integer = 0 To 51 Step 1
list(i) = i
Next i
Do While counter <= 51
p = rand.Next(0, 52)
templist(counter) = p
For n As Integer = 0 To 51 Step 1
p = rand.Next(0, 52)
If templist(n) = p Then
Do While templist(n) = p
p = rand.Next(0, 52)
Loop
templist(n) = p
Else
templist(n) = p
End If
Next
counter += 1
Loop
For n As Integer = 0 To 51 Step 1
ListBox1.Items.Add(templist(n))
Next
It will be a lot easier if you just have a list of all of the possible numbers (0 to 51 in your case), then remove the number from the list so it can't be picked again. Try something like this:
Dim allNumbers As New List (Of Integer)
Dim randomNumbers As New List (Of Integer)
Dim rand as New Random
' Fill the list of all numbers
For i As Integer = 0 To 51 Step 1
allNumbers.Add(i)
Next i
' Grab a random entry from the list of all numbers
For i As Integer = 0 To 51 Step 1
Dim selectedIndex as Integer = rand.Next(0, (allNumbers.Count - 1) )
Dim selectedNumber as Integer = allNumbers(selectedIndex)
randomNumbers.Add(selectedNumber)
allNumbers.Remove(selectedNumber)
' Might as well just add the number to ListBox1 here, too
ListBox1.Items.Add(selectedNumber)
Next i
If your goal is to get the numbers into ListBox1, then you don't even need the "randomNumbers" list.
EDIT:
If you must have an array, try something like this:
Function RandomArray(min As Integer, max As Integer) As Integer()
If min >= max Then
Throw New Exception("Min. must be less than Max.)")
End If
Dim count As Integer = (max - min)
Dim randomNumbers(count) As Integer
Dim rand As New Random()
' Since an array of integers sets every number to zero, and zero is possibly within our min/max range (0-51 here),
' we have to initialize every number in the array to something that is outside our min/max range.
If min <= 0 AndAlso max >= 0 Then
For i As Integer = 0 To count
randomNumbers(i) = (min - 1) ' Could also be max + 1
Next i
End If
Dim counter As Integer = 0
' Loop until the array has count # of elements (so counter will be equal to count + 1, since it is incremented AFTER we place a number in the array)
Do Until counter = count + 1
Dim someNumber As Integer = rand.Next(min, max + 1)
' Only add the number if it is not already in the array
If Not randomNumbers.Contains(someNumber) Then
randomNumbers(counter) = someNumber
counter += 1
End If
Loop
Return randomNumbers
End Function
This is good enough for your assignment, but the computer scientist in my hates this algorithm.
Here's why this algorithm is much less desirable. If zero is in your range of numbers, you will have to loop through the array at least 2N times (so 104+ times if you are going from 0 to 51). This is a best case scenario; the time complexity of this algorithm actually gets worse as the range of numbers scales higher. If you try running it from 0 to 100,000 for example, it will fill the first few thousand numbers very quickly, but as it goes on, it will take longer and longer to find a number that isn't already in the list. By the time you get to the last few numbers, you could potentially have randomly generated a few trillion different numbers before you find those last few numbers. If you assume an average complexity of 100000! (100,000 factorial), then the loop is going to execute almost ten to the half-a-millionth power times.
An array is more difficult to "shuffle" because it is a fixed size, so you can't really add and remove items like you can with a list or collection. What you CAN do, though, is fill the array with your numbers in order, then go through a random number of iterations where you randomly swap the positions of two numbers.
Do While counter <= 51
p = rand.Next(0, 52)
While Array.IndexOf(list, p) = -1
p = rand.Next(0, 52)
End While
counter += 1
Loop
Haven't written VB in about 5 years, but try this out:
Function GetRandomUniqueNumbersList(ByVal fromNumber As Integer, ByVal toNumber As Integer) As List(Of Integer)
If (toNumber <= fromNumber) Then
Throw New ArgumentException("toNumber must be greater than fromNumber", toNumber)
End If
Dim random As New Random
Dim randomNumbers As New HashSet(Of Integer)()
Do
randomNumbers.Add(random.Next(fromNumber, toNumber))
Loop While (randomNumbers.Count < toNumber - fromNumber)
Return randomNumbers.ToList()
End Function
Ok, that was painful. Please someone correct it if I made any mistakes. Should be very quick because it's using a HashSet.
First response to forum on stackoverflow - be gentle.
I was looking for a way to do this but couldn't find a suitable example online.
I've had a go myself and eventually got this to work:
Sub addUnique(ByRef tempList, ByVal n, ByRef s)
Dim rand = CInt(Rnd() * 15) + 1
For j = 0 To n
If tempList(j) = rand Then
s = True
End If
Next
If s = False Then
tempList(n) = rand
Else
s = False
addUnique(tempList, n, s)
End If
End Sub
Then call the sub using:
Dim values(15) As Byte
Dim valueSeen As Boolean = False
For i = 0 To 15
addUnique(values, i, valueSeen)
Next
This will randomly add the numbers 1 to 16 into an array. Each time a value is added, the previous values in the array are checked and if any of them are the same as the randomly generated value, s is set to true. If a value is not found (s=false), then the randomly generated value is added. The sub is recursively called again if s is still true at the end of the 'For' loop. Probably need 'Randomize()' in there somewhere.
Apologies if layout is a bit wobbly.

VBA Macro Run time error 6: overflow- coding inside a loop

Having a problem with this Error. I am creating a GA and the loop is to assign my fitness value to an array.
some of the variables
Dim Chromolength as integer
Chromolength = varchromolength * aVariables
Dim i as integer, j as integer, counter as integer
Dim Poparr() As Integer
Dim FitValarr() As Integer
the code:
ReDim Poparr(1 To PopSize, 1 To Chromolength)
For i = 1 To PopSize
For j = 1 To Chromolength
If Rnd < 0.5 Then
Poparr(i, j) = 0
Else
Poparr(i, j) = 1
End If
Next j
Next i
For i = 1 To PopSize
j = 1
counter = Chromolength
Do While counter > 0
FitValarr(i) = FitValarr(i) + Poparr(i, counter) * 2 ^ (j - 1)
j = j + 1
counter = counter - 1
Loop
Next i
I am having problems with:
FitValarr(i) = FitValarr(i) + Poparr(i, counter) * 2 ^ (j - 1)
I apologize, I am fairly new to VBA.
An overflow condition arises when you create an integer expression that evaluates to a value larger than can be expressed in a 16-bit signed integer. Given the expression, either the contents of FitValarr(i), or the expression 2^(j-1) could be overflowing. Suggest all the the variables presently declared as Int be changed to Long. Long integers are 32-bit signed values and provide a correspondingly larger range of possible values.
I had the same run time error 6. After much investigation l discovered that mine was a simple 'divide by zero' error.
I set up an integer value to hold Zip codes, and Error 6 events plagued me - until I realized that a zip code of 85338 exceeded the capacity of an int...
While I didn't think of a zip code as a "value" it was nonetheless certainly interpreted as one. I suspect the same could happen with addresses as well as other "non-numeric" numeric values. Changing the variable to a string resolved the problem.
It just didn't occur to me that a zip code was a "numeric value." Lesson learned.