I'm needing to take one array (firstArray) and input into a second array (secondArray). However, the first four fields are the same value. After the first four positions, it begins to alternate in values.
Example:
firstArray
+---------+
| ID# |
| Name |
| month1 |
| month2 |
| month3 |
| etc... |
+---------+
secondArray
+----------+
| ID# |
| Name |
| month1 |
| month2 |
| NewField |
| month3 |
| NewField |
| month4 |
| etc... |
+----------+
I'm fairly new to VBA, so I apologize for the awful code.
Code so far:
Dim i As Integer
i = 0
Dim j As Integer
ReDim secondArray(0 To (fieldCount - 4) * 2)
Dim finalCountDown As Integer
finalCountDown = (fieldCount - 4) * 2
secondArray(0) = firstArray(0)
secondArray(1) = firstArray(1)
secondArray(2) = firstArray(2)
secondArray(3) = firstArray(3)
i = 3
j = 3
Do Until i > finalCountDown
i = i + 1
secondArray(i) = "NewField"
i = i + 1
j = j + 1
secondArray(i) = firstArray(j)
Loop
I also have a MsgBox to iterate through and output my fields:
'//------ testing output
i = 0
For i = 0 To finalCountDown
MsgBox secondArray(i)
Next i
I appreciate any help! If there's any confusion, I'll gladly try to explain some more!
EDIT:
The two arrays are of different size but are dynamic. firstArray is firstly set to 20 positions while secondArray is originally set to 32 positions. (These are calculated each time this process is ran with the archived data being pulled. This allows my users to add data and not have to worry about having to manually add in the values to my arrays.)
EDIT2:
I've added Erik's portion to my code with a few alterations. I also added a separate counter for my firstArray in order to make sure it's inputting the correct rows into the correct positions of my secondArray.
EDIT3:
Here is the code that ended up working for me:
Dim i As Integer
i = 0
Dim j As Integer
'removed the " - 4"
ReDim secondArray(0 To (fieldCount * 2))
Dim finalCountDown As Integer
'removed the " - 4"
finalCountDown = (fieldCount * 2)
secondArray(0) = firstArray(0)
secondArray(1) = firstArray(1)
secondArray(2) = firstArray(2)
secondArray(3) = firstArray(3)
i = 3
'created own counter for firstArray
j = 3
Do Until i > finalCountDown
i = i + 1
secondArray(i) = "NewField"
i = i + 1
j = j + 1
secondArray(i) = firstArray(j)
Loop
The error I was getting was due "Subscript not in Range" due to the fact that my finalCountDown variable was less than my array needed to be. Allowing the variable to become larger than my array allowed my array to finish iterating through itself and now inputs the proper fields in the proper order.
I'm accepting Erik's answer as it was the stepping stone to answering the question!
For the adjusted code, you can do a simple check to check if the j value is valid:
Dim i As Integer
i = 0
Dim j As Integer
ReDim secondArray(0 To (fieldCount - 4) * 2)
Dim finalCountDown As Integer
finalCountDown = (fieldCount - 4) * 2
secondArray(0) = firstArray(0)
secondArray(1) = firstArray(1)
secondArray(2) = firstArray(2)
secondArray(3) = firstArray(3)
i = 3
j = 3
Do Until i > finalCountDown
i = i + 1
finalArray(i) = "NewField"
i = i + 1
j = j + 1
If j => LBound(colheaders) And j <= UBound(colHeaders) Then
finalArray(i) = colHeaders(j)
End If
Loop
Related
Description of the current situation:
I have an excel file of approximately 315 columns and 4000 rows. The file contains the answers to a 300-question questionnaire. The data format is as follows:
(Headers) A | B | C | D | E | F | Q.1 | Q.2 | ... | Q.300 |
(FirstRow) Info of first participant | AnswerCode for every Q |
The columns A to F contain contain info on every participant, while the columns Q.1 to Q.300 contain the respective answer code to each question. After storing the file as a large DataTable:
I need to load all 4000 rows on an existing database table, but before I do that I must edit the data format. The end result must become:
ParticipantCode | QuestionCode | AnswerCode | DateOfRegistration
00001 | 0001 | 1234567 | yyyy-MM-dd HH:mm:ss
... | ... | ... | ...
00001 | 0300 | 1234567 | yyyy-MM-dd HH:mm:ss
00002 | 0001 | 1234567 | yyyy-MM-dd HH:mm:ss
... | ... | ... | ...
04000 | 0300 | 1234567 | yyyy-MM-dd HH:mm:ss
So every row of the original ExcelDataTable is transformed into 300 rows in the FinalDataTable. In this way, the FinalDataTable will have about 1.2 million rows.
What Have I implemented so far:
Private Function MyFunction()
For Each ExcelRow As DataRow In ExcelDataTable.Rows
For Each ExcelColumn As DataColumn In ExcelDataTable.Columns
QuestionCodeFound = False
ExcelColumnNameRaw = ExcelColumn.ColumnName.ToString.Trim
If ExcelColumnNameRaw.StartsWith("Q") Then
' Correct the headers
ExcelColumnSplit = ExcelColumnNameRaw.Split("#")
ExcelColumnName = String.Concat(ExcelColumnSplit(0), ExcelColumnSplit(1))
SelectedRowFromDT = QuestionCodeAndQuestionIDDataTable.Select("QuestionID = '" + ExcelColumnName + "'")
' Search for "_", because some questions are different
If SelectedRowFromDT.Length > 0 Then
QuestionCodeFound = True
Else
Dim ExcelColumnSplitForMult As String()
ExcelColumnSplitForMult = ExcelColumnName.Split("_")
SelectedRowFromDT = QuestionCodeAndQuestionIDDataTable.Select("QuestionID = '" + ExcelColumnSplitForMult(0).ToString + "'")
If SelectedRowFromDT.Length > 0 Then
QuestionCodeFound = True
End If
End If
If QuestionCodeFound Then
Dim QuestionCode As String
Dim QuestionTypeDataTable As DataTable
Dim QuestionType As String
' Get the Question Type from the respective table
QuestionType = String.Empty
QuestionCode = SelectedRowFromDT(0).Item("QuestionCode").ToString
QuestionTypeDataTable = SearchInSql(My.Settings.ConnectionString, SQLString)
If QuestionTypeDataTable.Rows.Count > 0 Then
QuestionType = QuestionTypeDataTable.Rows(0).Item(0).ToString.Trim
End If
' Fix the Date Format
DateRaw = ExcelRow.Item(1).ToString
DateSplit = DateRaw.Split("/")
If DateSplit(0).Length = 1 Then
DateSplit(0) = String.Concat("0", DateSplit(0))
End If
If DateSplit(1).Length = 1 Then
DateSplit(1) = String.Concat("0", DateSplit(1))
End If
DateText = String.Concat(DateSplit(0), "/", DateSplit(1), "/", DateSplit(2))
DateRegistration = DateTime.ParseExact(DateText, "MM/dd/yyyy", CultureInfo.InvariantCulture)
DateRegistrationReformed = DateRegistration.ToString("yyyy-MM-dd", CultureInfo.InvariantCulture)
DateRegFinal = DateTime.ParseExact((DateRegistrationReformed + " " + "10:00:00").ToString, "yyyy-MM-dd HH:mm:ss", CultureInfo.InvariantCulture)
Dim AnswerValue As String
Dim AnswerCode As String
Dim AnswerCodeDataTable As DataTable
Dim QuestionWasAnswer As String
Dim AnswerValueRow() As DataRow = ExcelDataTable.Select("ParticipantCode = '" + ExcelRow.Item(2).ToString + "'")
AnswerCodeDataTable = New DataTable
AnswerValue = ""
QuestionWasAnswer = "0"
' Complete "QuestionWasAnswer" field for all questions and retrieve the AnswerCode for the answer given by each participant
If AnswerValueRow.Length > 0 And AnswerValueRow(0).Item(ExcelColumnNameRaw).GetType IsNot GetType(DBNull) Then
If Not (QuestionType.Equals("02") Or QuestionType.Equals("03")) Then
AnswerValue = AnswerValueRow(0).Item(ExcelColumnNameRaw)
QuestionWasAnswer = "1"
ElseIf QuestionType.Equals("02") Or QuestionType.Equals("03") Then
Dim ExcelColumnSplitForMultSecond As String()
Dim MultAnswerValue As String
ExcelColumnSplitForMultSecond = ExcelColumnName.Split("_")
MultAnswerValue = AnswerValueRow(0).Item(ExcelColumnNameRaw).ToString.Trim
AnswerValue = ExcelColumnSplitForMultSecond(1).ToString
If MultAnswerValue.Equals("1") Then
QuestionWasAnswer = "1"
ElseIf MultAnswerValue.Equals("2") Then
QuestionWasAnswer = "2"
End If
End If
' Search in the Answers table for the existing AnswerCode
SQLString = String.Format("SELECT Answers.AnswerCode
FROM Answers
WHERE Answers.QuestionCode = '{0}'
AND (Answers.AnswerNumber = '{1}' OR Answers.Answer = '{1}')", QuestionCode, AnswerValue)
AnswerCodeDataTable = SearchInSql(My.Settings.ConnectionString, SQLString)
If AnswerCodeDataTable.Rows.Count > 0 Then
AnswerCode = AnswerCodeDataTable.Rows(0).Item(0).ToString
FormattedDataTable.Rows.Add(ParticipantAnswerCode, ExcelRow.Item(2), QuestionCode, AnswerCode, QuestionWasAnswer, DateRegFinal)
ParticipantAnswerCode = Convert.ToInt32(ParticipantAnswerCode + 1).ToString.PadLeft(ParticipantAnswerCodeFieldLength, "0")
Else
' If a given answer does not exist, save it in the respective table and then try again
Dim AnswerCodeLength = GetLengthFromSqlDataBase(My.Settings.ConnectionString, "Answers", "AnswerCode")
Dim NextAnswerCode = CalculateNextAnswerCode(AnswerCodeLength)
Dim NestAnswerNumber = CalculateNextAnswerNumber(QuestionCode)
SaveNewAnswer(NextAnswerCode, QuestionCode, NestAnswerNumber, AnswerValue)
SQLString = String.Format("SELECT Answers.AnswerCode
FROM Answers
WHERE Answers.QuestionCode = '{0}'
AND Answers.Answer = '{1}'", QuestionCode, AnswerValue)
AnswerCodeDataTable = SearchInSql(My.Settings.ConnectionString, SQLString)
If AnswerCodeDataTable.Rows.Count > 0 Then
AnswerCode = AnswerCodeDataTable.Rows(0).Item(0).ToString
FormattedDataTable.Rows.Add(ParticipantAnswerCode, ExcelRow.Item(2), QuestionCode, AnswerCode, QuestionWasAnswer, DateRegFinal)
ParticipantAnswerCode = Convert.ToInt32(ParticipantAnswerCode + 1).ToString.PadLeft(ParticipantAnswerCodeFieldLength, "0")
End If
End If
End If
End If
End If
Next
Next
Return FormattedDataTable
End Function
After that, I bulk insert the FinalDataTable on the DB.
The problem I am facing:
Using the current program I built, every row in the ExcelDataTable takes about 40 seconds to transform into 300 rows in the FinalDataTable. If I try to load all 4000 rows, it will take more than 40 hours to transform the entire datatable. I need to find a faster way to do this.
As mentioned, there isn't much to go off of on this with what has been provided.
I'm sure there are more helpful fixes to consider but I wanted to put my two cents in about the For Loops.
I recommend switching the
For Each
statements with
For i as integer = 0 to ExcelDataTable.Rows.Count - 1
I've read that For Each is not as performance-friendly as it gathers each "row" as a collection, therefore increasing the overhead per loop.
Here is a SO post about this subject:
Major difference between 'for each' and 'for' loop in .NET
Not sure if that will make a difference for you but thought I would recommend it anyway.
I previously have a Excel sheet with VBA coding that fills column, row 1 to 10 with the number 1, row 11 to 20 with number 2 and so on. The code I've used is as follows:
Sub fill()
Dim ID
ID = 1
For c = 1 To 34
ActiveWorkbook.Sheets("Sheet1").Cells(c, 1) = ID
ActiveWorkbook.Sheets("Sheet1").Cells(c + 1, 1) = ID
c = c + 1
If (c Mod 10) = 0 Then
ID = ID + 1
End If
Next c
End Sub
Now I want to change it so that the code starts at row 3 onwards. Meaning row 3 to 12 = 1, row 13 to 22 = 2 and so on. So I changed the 'For' statement to:
For c = 3 To 34
But what happens is that the number 1 appears from row 3 to row 10, and then continues with number 2 in row 11 to 20. Not what I was expecting.
Therefore, what would be the best method of changing the code?
If you want exactly the same output but two rows lower, you can use:
Sub fill()
Dim ID
ID = 1
For c = 1 To 34
ActiveWorkbook.Sheets("Sheet1").Cells(c + 2, 1) = ID
ActiveWorkbook.Sheets("Sheet1").Cells(c + 3, 1) = ID
c = c + 1
If (c Mod 10) = 0 Then
ID = ID + 1
End If
Next c
End Sub
If you still only want to go to row 34 but start in row 3, change the 34 to 32 in the above code.
You can also do it without looping and this is easier to adjust the parameters:
Sub fill()
Const NUMBER_OF_ROWS As Long = 34
Const START_ROW As Long = 3
Const ID As Long = 1
Const NUMBER_IN_GROUP As Long = 10
With ActiveWorkbook.Sheets("Sheet1").Cells(START_ROW, 1).Resize(NUMBER_OF_ROWS)
.Value = .Parent.Evaluate("INDEX(INT((ROW(" & .Address & ")-" & START_ROW & ")/" & _
NUMBER_IN_GROUP & ")+" & ID & ",)")
End With
End Sub
When i understand you write, this should work:
You can use the loop how you did at the beginning. and just add plus 2 to c in the ActiveWorkbook.Sheets("Tabelle1").Cells(c + 2, 1) = ID
Sub fill()
Dim ID
ID = 1
For c = 1 To 34
ActiveWorkbook.Sheets("Tabelle1").Cells(c + 2, 1) = ID
ActiveWorkbook.Sheets("Tabelle1").Cells(c + 3, 1) = ID
c= c+1
If (c Mod 10) = 0 Then
ID = ID + 1
End If
Next c
End Sub
something like that should be the simplest way:
Sub fill()
Dim i As Integer
Dim j As Integer
For i = 1 To 4
For j = 1 To 10
ActiveWorkbook.Sheets("Sheet1").Cells(j + (i - 1) * 10 + 2, 1) = i
Next j
Next i
End Sub
EDIT:
No, the simplest way would be type formula into A3:
=ROUNDDOWN(((ROW()-3))/10,0)+1
end drag it donw.
I have raw data I'm trying to sort out by date, the data is in this form:
month:april-2014
offer | value
ofr x | 2132
ofr y | 135
.
.
.
month:mai-2014
offer | value
ofr x | 5115
ofr z | 513
ofr y | 651
and it goes on, there are offers that apear every month and others that dissapear.
I wanted it to look like this :
offer | april-2014 |mai 14 | june ....
ofr x 123 5 6
ofr y 5 1 6
ofr z
ofr a
.
.
any help would be appreciated, thank you
Try to restructure the data like this and use pivot tables?
Date | offer | value
may-2014 |ofr x | 5115
may-2014 |ofr z | 513
may-2014 |ofr y | 651
This first chunk of code is going through and rearranging things for you. The other important thing it does is only sends one column from your selected range to the function. Some important things to remember are you may need to write the search criteria if you key word for "month" is not in the same spot in the text, the word offer is not by itself with no spaces in the following row. Another point of note, is this is treating everything as is. That means if the source cell was text, then the destination cell will be text. To convert from date as text to date as Excel serial that is a separate issue and there are plenty of ways to achieve that as well.
Option Explicit
Sub SortOffer(OfferList As Range)
Dim CounterX As Long, CounterY As Long, jCounter As Long, icounter As Long, MonthCount As Long, UniqueOffers As Long
Dim inlist As Boolean
Dim unsorted() As Variant
Dim sorted() As Variant
MonthCount = WorksheetFunction.CountIf(OfferList, "month*")
UniqueOffers = CountUnique(OfferList.Columns(1).Cells) - MonthCount - 1
ReDim sorted(1 To UniqueOffers + 1, 1 To MonthCount + 1) As Variant
unsorted = OfferList
CounterX = 1
jCounter = 1
sorted(1, 1) = "offer"
For CounterY = LBound(unsorted, 1) To UBound(unsorted, 1)
If Left(unsorted(CounterY, 1), 5) = "month" Then
CounterX = CounterX + 1
sorted(1, CounterX) = Right(unsorted(CounterY, 1), Len(unsorted(CounterY, 1)) - 6)
Else
inlist = False
For icounter = 2 To jCounter
If unsorted(CounterY, 1) = sorted(icounter, 1) Then
sorted(icounter, CounterX) = unsorted(CounterY, 2)
inlist = True
End If
Next icounter
If Not inlist And unsorted(CounterY, 1) <> "offer" And unsorted(CounterY, 1) <> "" Then
jCounter = jCounter + 1
sorted(jCounter, 1) = unsorted(CounterY, 1)
sorted(jCounter, CounterX) = unsorted(CounterY, 2)
End If
End If
Next CounterY
Range("F1").Resize(UBound(sorted, 1), UBound(sorted, 2)).Value = sorted
End Sub
This next function counts the number of unique entries in a range and does not count spaces. I stumbled across this code on this web page. If you subtract the number of months from this count, you will know how many offers are in your table. This is important because it will tell you how to size your array(alt link) that you will later write back as your results
Function CountUnique(ByVal MyRange As Range) As Integer
Dim Cell As Range
Dim J As Integer
Dim iNumCells As Integer
Dim iUVals As Integer
Dim sUCells() As String
iNumCells = MyRange.Count
ReDim sUCells(iNumCells) As String
iUVals = 0
For Each Cell In MyRange
If Cell.Text > "" Then
For J = 1 To iUVals
If sUCells(J) = Cell.Text Then
Exit For
End If
Next J
If J > iUVals Then
iUVals = iUVals + 1
sUCells(iUVals) = Cell.Text
End If
End If
Next Cell
CountUnique = iUVals
End Function
Now just in case the links don't cover it, this answer which was a learning lesson for me was taught in various parts to me by #JNevill, #Ralph, #findwindow, #Gary'sStudent and #ScottCraner. Appologies if I missed someone. I am also sure any of these individuals could do it slicker and take less then 10 hours to write it 8).
Example :
If a got word "don" then file will contain
ddd
ddo
ddn
dod
doo
don
dnd
dno
dnn
odd
odo
odn
ood
<...>
I have no idea to do this. Not less then 3 symbol words.
I presented a solution in Experts Exchange, which you may not be able to see (if you never payed them) so I copy it for you:
Question was:
I have n items and each item can be assigned a 1 or a 2. So I would like to get the matrix result that would generate all possible combinations.
For eg. if n= 3 , then the possible outcomes are : I need an algorithm that can generate this series for n . Please help thanks. ideally i would like to store the result in a datatable
1 1 1
1 1 2
1 2 1
2 1 1
2 1 2
1 2 2
2 2 1
2 2 2
Answer:
Dim HighestValue As Integer = 2 ' max value
Dim NrOfValues As Integer = 3 ' nr of values in one result
Dim Values(NrOfValues) As Integer
Dim i As Integer
For i = 0 To NrOfValues - 1
Values(i) = 1
Next
Values(NrOfValues - 1) = 0 ' to generate first as ALL 1
For i = 1 To HighestValue ^ NrOfValues
Values(NrOfValues - 1) += 1
For j As Integer = NrOfValues - 1 To 0 Step -1
If Values(j) > HighestValue Then
Values(j) = 1
Values(j - 1) += 1
End If
Next
Dim Result As String = ""
For j As Integer = 0 To NrOfValues - 1
Result = Result & CStr(Values(j))
Next
Debug.WriteLine(Result)
Next
Ok Here's the solution, you just need to change the Debug.Writeline with a write to your file
Dim HighestValue As Integer = 3 ' max value
Dim NrOfValues As Integer = 3 ' nr of values in one result
Dim Values(NrOfValues) As Integer
Dim i As Integer
For i = 0 To NrOfValues - 1
Values(i) = 1
Next
Values(NrOfValues - 1) = 0 ' to generate first as ALL 1
For i = 1 To HighestValue ^ NrOfValues
Values(NrOfValues - 1) += 1
For j As Integer = NrOfValues - 1 To 0 Step -1
If Values(j) > HighestValue Then
Values(j) = 1
Values(j - 1) += 1
End If
Next
Dim Result As String = ""
For j As Integer = 0 To NrOfValues - 1
If Values(j) = 1 Then Result = Result & "d"
If Values(j) = 2 Then Result = Result & "o"
If Values(j) = 3 Then Result = Result & "n"
'Result = Result & CStr(Values(j))
Next
Debug.WriteLine(Result)
Next
I am trying to create a lottery simulator. The lottery has 6 numbers, the number generated must be between 1 - 49 and cannot be in the next number generated. I have tried using the OR function but I'm not entirely sure if I am using it properly. Any help would be great. Thanks.
Public Class Form1
Private Sub cmdRun_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdRun.Click
''#Creates a new Random class in VB.NET
Dim RandomClass As New Random()
''####################################
Dim RandomNumber1 As Integer
RandomNumber1 = RandomClass.Next(1, 49)
''#Displays first number generated
txtFirst.Text = (RandomNumber1)
''####################################
Dim RandomNumber2 As Integer
RandomNumber2 = RandomClass.Next(1, 49)
If RandomNumber2 = RandomNumber1 Then
RandomNumber2 = RandomClass.Next(1, 49)
End If
''#Displays second number generated
txtSecond.Text = (RandomNumber2)
''####################################
Dim RandomNumber3 As Integer
RandomNumber3 = RandomClass.Next(1, 49)
If RandomNumber3 = RandomNumber2 Or RandomNumber2 Then
RandomNumber3 = RandomClass.Next(1, 49)
End If
''#Displays third number generated
txtThird.Text = (RandomNumber3)
''####################################
Dim RandomNumber4 As Integer
RandomNumber4 = RandomClass.Next(1, 49)
If RandomNumber4 = RandomNumber3 Or RandomNumber2 Or RandomNumber1 Then
RandomNumber4 = RandomClass.Next(1, 49)
End If
''#Displays fourth number generated
txtFourth.Text = (RandomNumber4)
''####################################
Dim RandomNumber5 As Integer
RandomNumber5 = RandomClass.Next(1, 49)
If RandomNumber5 = RandomNumber4 Or RandomNumber3 Or RandomNumber2 Or RandomNumber1 Then
RandomNumber5 = RandomClass.Next(1, 49)
End If
''#Displays fifth number generated
txtFifth.Text = (RandomNumber5)
''####################################
Dim RandomNumber6 As Integer
RandomNumber6 = RandomClass.Next(1, 49)
If RandomNumber6 = RandomNumber5, RandomNumber4, RandomNumber3, RandomNumber2, RandomNumber1 Then
RandomNumber6 = RandomClass.Next(1, 49)
End If
''#Displays sixth number generated
txtSixth.Text = (RandomNumber6)
End Sub
Instead of "If", use "While" - in other words, keep generating random numbers until you find a new one. Currently if you get a duplicate and then get a duplicate on the second attempt, you'll keep going.
Also, while I'm no VB expert, I believe you'll need to specify each comparison in full, so instead of this:
If RandomNumber3 = RandomNumber2 Or RandomNumber2 Then
RandomNumber3 = RandomClass.Next(1, 49)
End If
you need:
While RandomNumber3 = RandomNumber1 Or RandomNumber3 = RandomNumber2 Then
RandomNumber3 = RandomClass.Next(1, 49)
End While
There are alternatives here - such as generating the numbers 1-49, shuffling them, and then fetching the first 6 results... or keeping to the "pick until there's a new one" but keep the results in a set. Either way you could avoid having quite so much code duplication.
You don't just need a random number generator here, you need one in conjunction with a shuffling algorithm.
Create an array of N items (we'll use seven for our example), each containing the integer relating to its position:
+---+---+---+---+---+---+---+
| 1 | 2 | 3 | 4 | 5 | 6 | 7 |
+---+---+---+---+---+---+---+
<pool(7)
and set the pool size to 7.
Then generate your random number, based on the pool size (i.e., get a number from 1 to 7). Let's say your generator returns 3.
Pull out the value at position 3 then replace that with the top value, then reduce the pool size:
+---+---+---+---+---+---+---+
| 1 | 2 | 7 | 4 | 5 | 6 | 7 | -> 3
+---+---+---+---+---+---+---+
<pool(6)
Then you just keep doing this until you've gotten the quantity of values required. If our lotto was 5 from 7:
+---+---+---+---+---+---+---+
| 1 | 2 | 7 | 4 | 5 | 6 | 7 |
+---+---+---+---+---+---+---+
<pool(7)
rnd(7) returns 3
+---+---+---+---+---+---+---+
| 1 | 2 | 7 | 4 | 5 | 6 | 7 | -> 3
+---+---+---+---+---+---+---+
<pool(6)
rnd(6) returns 1
+---+---+---+---+---+---+---+
| 6 | 2 | 7 | 4 | 5 | 6 | 7 | -> 1
+---+---+---+---+---+---+---+
<pool(5)
rnd(5) returns 5
+---+---+---+---+---+---+---+
| 6 | 2 | 7 | 4 | 5 | 6 | 7 | -> 5
+---+---+---+---+---+---+---+
<pool(4)
rnd(4) returns 2
+---+---+---+---+---+---+---+
| 6 | 4 | 7 | 4 | 5 | 6 | 7 | -> 2
+---+---+---+---+---+---+---+
<pool(3)
rnd(3) returns 1
+---+---+---+---+---+---+---+
| 7 | 4 | 7 | 4 | 5 | 6 | 7 | -> 6
+---+---+---+---+---+---+---+
<pool(2)
and there you have it, 5-from-7 numbers (3,1,5,2,6) extracted with no possibilities of duplicates and an efficient O(n) method for getting them. Any solution that relies on just getting random numbers and checking if they've already been used will be less efficient.
Here's another option using LINQ if you have VB2008:
Dim rnd As New Random()
Dim randomNumbers = From n in Enumerable.Range(1, 49) _
Order By rnd.Next() _
Select n _
Take 6
'Do something with the numbers here
This is a simple way to do it. If using the Random class is not random enough, then you may have to choose an alternative method.
You have to change the name of the textbox I'm using to the one you're using.
Dim rand As New Random
Dim winnum As New List(Of Integer)
Dim num, counter As Integer
Dim result As String = ""
Do
num = rand.Next(1, 49)
If winnum.Contains(num) Then
Do
num = rand.Next(1, 49)
Loop Until winnum.Contains(num) = False
End If
winnum.Add(num)
counter += 1
Loop Until counter = 6
'Extracting and displaying the numbers from the array
For n As Integer = 0 To 5
result = winnum(n) & " " & result
Next
'The textbox I'm using to display the result is result.text
result.Text = result
You can also use code as another fellow suggested above. In the code below, numbers are generated randomly and are removed from a pool of numbers until the required quantity is reached. Then the numbers left are then displayed. However this is not such a good way for generating numbers for lottery as the sequence of numbers are somehow predictable, but they are unique. Here is the code:
Dim rand As New Random, winnum As New List(Of Integer)
Dim num As Integer, result As String = ""
For n As Integer = 1 To 49
winnum.Add(n)
Next
Do
num = rand.Next(1, 49)
If winnum.Contains(num) Then
winnum.Remove(num)
End If
Loop Until winnum.Count = 7
For n As Integer = 0 To 5
result = winnum(n) & " " & result
Next
a.Text = result
I'd go for something like (in C#)
public static IEnumerable<int> Lotto(int max)
{
var random = new Random((int)DateTime.Now.Ticks);
var numbers = new List<int>(Enumerable.Range(1, max));
while(numbers.Count > 0)
{
int index = random.Next(1, numbers.Count) - 1;
yield return numbers[index];
numbers.RemoveAt(index);
}
}
static void Main(string[] args)
{
var lotto = Lotto(49).GetEnumerator();
lotto.MoveNext();
int r1 = lotto.Current;
lotto.MoveNext();
int r2 = lotto.Current;
lotto.MoveNext();
int r3 = lotto.Current;
Console.WriteLine("{0} {1} {2}", r1, r2, r3 );
}
Instead of picking random numbers and check for duplicates, you can simply loop through the numbers and check the odds for each number to be picked against a random number:
Dim count As Integer = 6 ' How many numbers to pick
Dim pos As Integer = 1 ' Lowest value to pick from
Dim items As Integer = 49 ' Number of items in the range
Dim rnd As New Random()
Dim result As New List(Of Integer)()
While count > 0
If rnd.Next(items) < count Then
result.Add(pos)
count -= 1
End If
pos += 1
items -= 1
End While
The list result now contains six numbers without duplicates, randomly picked from the range 1-49. As an extra bonus the numbers in the list are already sorted.
I think shuffling is the fastest alternative too. But easier to read is your approach in combination with a collections's contains function:
Dim numbers As New List(Of Int32)
For i As Int32 = 1 To 6
Dim containsNextNumber As Boolean = False
While Not containsNextNumber
Dim rnd As New Random(Date.Now.Millisecond)
Dim nextNumber As Int32 = rnd.Next(1, 50)
If Not numbers.Contains(nextNumber) Then
numbers.Add(nextNumber)
containsNextNumber = True
End If
End While
Next
numbers.Sort() 'sort the numbers from low to high