I am making a program for a game. It takes the level of the class (of which you can have 8 simultaneous different ones of different level). Each class has different values for one Dim I have known as Defense, it has 6 different possibly levels. Each of those 6 levels corresponds with a value based on the level of each class.
I'm almost certain I need an array or a list, I've seen some examples here but I haven't seen something that quite fits my case.
Do I need to have an array within an array? Is that even possible?
I apologize if I'm horrible at explaining what I'm trying to accomplish.
An example would be if the person chose Strong Hero and then chose Level 4. Following that they'd pick Fast Hero and chose Level 5. I'm trying to get it to look at what the value for 4 would be for Strong Hero and the value for Fast Hero, find those and then add them into Def at the end.
Thank you in advance for anyone who is willing to put up with my ignorance!
Dim Def As Integer = 0
'Declares a single-dimension array of 10 values
Dim DefLvl(9) As Integer
Dim DefType As String = ""
Dim DefLvl1 As Integer = 0
Dim DefLvl2 As Integer = 0
Dim DefLvl3 As Integer = 0
Dim DefLvl4 As Integer = 0
Dim DefLvl5 As Integer = 0
Dim DefLvl6 As Integer = 0
Dim DefLvl7 As Integer = 0
Dim DefLvl8 As Integer = 0
Dim DefLvl9 As Integer = 0
Dim DefLvl10 As Integer = 0
'This sets the cmblevel.text = to an integer to be multiplied later
'Level 1
If cmbLevel1.Text = "1" Then
Level1 = 1
ElseIf cmbLevel1.Text = "2" Then
Level1 = 2
ElseIf cmbLevel1.Text = "3" Then
Level1 = 3
ElseIf cmbLevel1.Text = "4" Then
Level1 = 4
ElseIf cmbLevel1.Text = "5" Then
Level1 = 5
ElseIf cmbLevel1.Text = "6" Then
Level1 = 6
ElseIf cmbLevel1.Text = "7" Then
Level1 = 7
ElseIf cmbLevel1.Text = "8" Then
Level1 = 8
ElseIf cmbLevel1.Text = "9" Then
Level1 = 9
ElseIf cmbLevel1.Text = "10" Then
Level1 = 10
End If
'
If cmbClass1.Text = "Strong Hero" Then
HD1 = "8"
DefType = "Avg+"
DefLvl1 = 1
DefLvl2 = 2
DefLvl3 = 2
DefLvl4 = 3
DefLvl5 = 3
DefLvl6 = 3
DefLvl7 = 4
DefLvl8 = 4
DefLvl9 = 5
DefLvl10 = 5
End If
'This formula will calculate Defense for each class and level
If DefType = "Poor" Then
DefLvl1 = 0
DefLvl2 = 1
DefLvl3 = 1
DefLvl4 = 1
DefLvl5 = 2
DefLvl6 = 2
DefLvl7 = 2
DefLvl8 = 3
DefLvl9 = 3
DefLvl10 = 3
ElseIf DefType = "Avg" Then
DefLvl1 = 1
DefLvl2 = 1
DefLvl3 = 2
DefLvl4 = 2
DefLvl5 = 3
DefLvl6 = 3
DefLvl7 = 4
DefLvl8 = 4
DefLvl9 = 5
DefLvl10 = 5
ElseIf DefType = "Avg+" Then
DefLvl1 = 1
DefLvl2 = 2
DefLvl3 = 2
DefLvl4 = 3
DefLvl5 = 3
DefLvl6 = 3
DefLvl7 = 4
DefLvl8 = 4
DefLvl9 = 5
DefLvl10 = 5
ElseIf DefType = "Good" Then
DefLvl1 = 1
DefLvl2 = 2
DefLvl3 = 2
DefLvl4 = 3
DefLvl5 = 4
DefLvl6 = 4
DefLvl7 = 5
DefLvl8 = 6
DefLvl9 = 6
DefLvl10 = 7
ElseIf DefType = "Good+" Then
DefLvl1 = 1
DefLvl2 = 2
DefLvl3 = 2
DefLvl4 = 3
DefLvl5 = 4
DefLvl6 = 4
DefLvl7 = 5
DefLvl8 = 6
DefLvl9 = 7
DefLvl10 = 7
ElseIf DefType = "Great" Then
DefLvl1 = 3
DefLvl2 = 4
DefLvl3 = 4
DefLvl4 = 5
DefLvl5 = 5
DefLvl6 = 6
DefLvl7 = 6
DefLvl8 = 7
DefLvl9 = 7
DefLvl10 = 8
End If
'This adds up to all 8 classes' DefLvls
Def = DefLvl1 + DefLvl2 + DefLvl3 + DefLvl4 + DefLvl5 + DefLvl6 + DefLvl7 + DefLvl8 + dexM
Related
I'm trying to shift the bits from old: to new:, If 2 same values are encountered a second time, then it should skip them I guess, that's why first example is broken.
Here is my code:
txtUndoPlaintext.Text = Replace(txtUndoPlaintext.Text, " ", " ")
txtUndoPlaintext.Text = txtUndoPlaintext.Text.TrimStart(CChar(" "))
txtUndoPlaintext.Text = txtUndoPlaintext.Text.TrimEnd(CChar(" "))
Dim UniqueList() As Byte = Split(txtUndoPlaintext.Text, " ").[Select](Function(n) Byte.Parse(n)).ToArray()
txtPlainText.Text = Replace(txtPlainText.Text, " ", " ")
txtPlainText.Text = txtPlainText.Text.TrimStart(CChar(" "))
txtPlainText.Text = txtPlainText.Text.TrimEnd(CChar(" "))
Dim OriginalUniqueList() As Byte = Split(txtPlainText.Text, " ").[Select](Function(n) Byte.Parse(n)).ToArray()
txtUndoBitMask.Text = Replace(txtUndoBitMask.Text, " ", " ")
txtUndoBitMask.Text = txtUndoBitMask.Text.TrimStart(CChar(" "))
txtUndoBitMask.Text = txtUndoBitMask.Text.TrimEnd(CChar(" "))
bitmask = Split(txtUndoBitMask.Text, " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim newbitmask() As Byte = Nothing
Array.Resize(newbitmask, bitmask.Length)
'Array.Copy(bitmask, newbitmask, bitmask.Length)
bitmaskCounter = 0
For i = 0 To UniqueList.Length - 1
For j = (i + 1) To OriginalUniqueList.Length - 1
If OriginalUniqueList(i) = UniqueList(j) Then
Exit For
End If
Next j
'If OriginalUniqueList(i) = UniqueList(i) Then
' bitmaskCounter += 1
' Continue For
' End If
'If OriginalUniqueList(j) = UniqueList(j) Then
'bitmaskCounter += 1
'Continue For
'End If
If (j < OriginalUniqueList.Length - 1) AndAlso newbitmask(i) = 1 AndAlso newbitmask(j) = 1 AndAlso bitmask(bitmaskCounter) = 1 Then
newbitmask(i) = 1
newbitmask(j) = 1
ElseIf (j > OriginalUniqueList.Length - 1) AndAlso bitmask(bitmaskCounter) = 1 Then
newbitmask(i) = 1
ElseIf (j < OriginalUniqueList.Length - 1) AndAlso OriginalUniqueList(i) = UniqueList(i) Then
newbitmask(i) = 0
ElseIf bitmask(bitmaskCounter) = 1 Then
newbitmask(j) = 1
End If
bitmaskCounter += 1
Next
Broken Example.
value before: 1 2 1 3 2 4 3 8 2 2 1 3 4 2 1 2
value after: 1 2 4 3 1 2 3 4 3 2 1 8 2 1 2 2
old: 0 0 1 1 0 0 0 1 0 0 0 0 0 0 0 0
new: 0 0 0 0 1 0 0 0 1 0 0 1 0 0 0 0
2,4 = good
3,8 = bad [this is broken]
7,11 = good
Here are good examples that work properly.
Good Example.
value before: 1 2 3 1 2 3 4 1 2 3 4
value after: 1 2 3 4 1 2 3 4 1 2 3
old: 0 0 0 1 0 0 1 0 0 0 0
new: 0 0 0 0 1 0 0 1 0 0 0
3,4 = good
6,7 = good
Good Example.
value before: 1 2 1 3 2 3 2 4
value after: 1 2 4 1 2 3 2 3
old: 0 0 1 1 0 1 0 0
new: 0 0 0 1 0 1 0 1
2,3 = good
3,5 = good
5,7 = good
Good Example.
value before: 1 2 1 3 2
value after: 1 2 1 2 3
old: 0 0 1 1 0
new: 0 0 1 0 1
2,2 = good
3,4 = good
New Code update
Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click
Dim bitmaskCounter As Integer = 0
Dim UniqueList() As Byte = Split("1 2 1 3 2 4 3 8 2 2 1 3 4 2 1 2", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim OriginalUniqueList() As Byte = Split("1 2 4 3 1 2 3 4 3 2 1 8 2 1 2 2", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim TheValues = New List(Of Byte)(UniqueList)
bitmask = Split("0 0 1 1 0 0 0 1 0 0 0 0 0 0 0 0", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim newbitmask() As Byte = Nothing
Array.Resize(newbitmask, bitmask.Length)
'Array.Copy(bitmask, newbitmask, bitmask.Length)
bitmaskCounter = 0
Dim i As Integer = 0
Dim j As Integer = 0
Dim ignoreOldOffsets As New List(Of Short)
Dim ignoreNewOffsets As New List(Of Short)
Dim found As Boolean = False
While i >= 0
found = False
Do While j > 0
If j = OriginalUniqueList.Length Then Exit Do
If OriginalUniqueList(j) = UniqueList(i) Then
found = True
Exit Do
End If
j += 1
Loop
If bitmaskCounter >= bitmask.Length Then Exit While
If j = i AndAlso OriginalUniqueList(j) = UniqueList(i) OrElse j = OriginalUniqueList.Length Then
bitmaskCounter += 1
ignoreOldOffsets.Add(i)
ignoreNewOffsets.Add(j)
j = i + 1
i += 1
Continue While
End If
If ignoreOldOffsets.Contains(i) AndAlso ignoreNewOffsets.Contains(j) Then
bitmaskCounter += 1
j = i
Continue While
End If
'If OriginalUniqueList(j) = UniqueList(j) Then
'bitmaskCounter += 1
'Continue For
'End If
'newbitmask(i) = 1
'newbitmask(j) = 1
'ignoreOffsets.Add(i)
'ignoreOffsets.Add(j)
If bitmask(i) = 1 Then
newbitmask(i) = 1
newbitmask(j) = 1
ignoreOldOffsets.Add(i)
ignoreNewOffsets.Add(j)
End If
bitmaskCounter += 1
i += 1
j = i
End While
'Fixed bits output to textbox.
txtOutput.Text += "New Bits: "
For i = 0 To newbitmask.Length - 1
txtOutput.Text += newbitmask(i) & " "
Next
txtOutput.Text += vbCrLf
'Reset bitmaskCounter.
bitmaskCounter = 0
End Sub
In the code above
old: 0 0 1 1 0 0 0 1 0 0 0 0 0 0 0 0
new: 0 0 0 0 1 0 0 0 1 0 0 1 0 0 0 0
i get: 0 0 1 0 1 0 0 1 0 0 0 1 0 0 0 0
Solved!!!
Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click
Dim bitmaskCounter As Integer = 0
'Dim UniqueList() As Byte = Split("1 2 1 3 2 4 3 8 2 2 1 3 4 2 1 2", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim OriginalUniqueList() As Byte = Split("1 2 4 3 1 2 3 4 3 2 1 8 2 1 2 2", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim TheValues = New List(Of Byte)(UniqueList)
'bitmask = Split("0 0 1 1 0 0 0 1 0 0 0 0 0 0 0 0", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim UniqueList() As Byte = Split("1 2 3 1 2 3 4 1 2 3 4", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim OriginalUniqueList() As Byte = Split("1 2 3 4 1 2 3 4 1 2 3", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim TheValues = New List(Of Byte)(UniqueList)
'bitmask = Split("0 0 0 1 0 0 1 0 0 0 0", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim UniqueList() As Byte = Split("1 2 1 3 2 3 2 4", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim OriginalUniqueList() As Byte = Split("1 2 4 1 2 3 2 3", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Dim TheValues = New List(Of Byte)(UniqueList)
'bitmask = Split("0 0 1 1 0 1 0 0", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim UniqueList() As Byte = Split("1 2 1 3 2", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim OriginalUniqueList() As Byte = Split("1 2 1 2 3", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim TheValues = New List(Of Byte)(UniqueList)
bitmask = Split("0 0 1 1 0", " ").[Select](Function(n) Byte.Parse(n)).ToArray()
Dim newbitmask() As Byte = Nothing
Array.Resize(newbitmask, bitmask.Length)
'Array.Copy(bitmask, newbitmask, bitmask.Length)
bitmaskCounter = 0
Dim i As Integer = 0
Dim j As Integer = 0
Dim found As Boolean = False
Dim firstDuplicateIndex As Integer = -1
Dim uniquesFound As New List(Of Byte)
For k = 0 To UniqueList.Length - 1
If uniquesFound.Contains(OriginalUniqueList(k)) = False Then
uniquesFound.Add(OriginalUniqueList(k))
Else
firstDuplicateIndex = k
Exit For
End If
Next
Dim offsetsComplete As New List(Of Integer)
While i >= 0
i = Array.IndexOf(bitmask, CByte(1), i + 1)
j = i '(i + 1)
If i = -1 OrElse UniqueList.Length = i Then Exit While
found = False
Do While j >= 0
If j = OriginalUniqueList.Length Then Exit Do
If j < firstDuplicateIndex OrElse OriginalUniqueList(j) = UniqueList(j) AndAlso bitmask(j) <> 1 OrElse offsetsComplete.Contains(j) Then
j += 1
Continue Do
End If
If OriginalUniqueList(j) = UniqueList(i) Then
found = True
Exit Do
End If
j += 1
Loop
If bitmaskCounter >= bitmask.Length Then Exit While
If j < bitmask.Length AndAlso bitmask(i) = 1 Then
newbitmask(j) = 1
offsetsComplete.Add(j)
End If
bitmaskCounter += 1
End While
'Fixed bits output to textbox.
txtOutput.Text += "New Bits A: 0 0 0 0 1 0 0 0 1 0 0 1 0 0 0 0" & vbNewLine
txtOutput.Text += "New Bits B: "
For i = 0 To newbitmask.Length - 1
txtOutput.Text += newbitmask(i) & " "
Next
txtOutput.Text += vbCrLf
'Reset bitmaskCounter.
bitmaskCounter = 0
End Sub
I want to create a bidimensional array to plot checkboxes in rows and cols. Nevertheless, this line is not working:
CheckB_Well(rows_C1, cols_C1).Location = New Point(40 + 50 * cols_C1, 20 + 25 * (well_rows - 1 - rows_C1))
The checkboxes are not shown in the location defined.
Sub Check_Panel()
Me.GroupBox3.Controls.Clear()
Dim CheckB_Well(,)
Dim rows_C1 As Integer
Dim cols_C1 As Integer
If Opt6.Checked = True Then
well_number = 6
well_rows = 2
well_cols = 3
ElseIf Opt12.Checked = True Then
well_number = 12
well_rows = 3
well_cols = 4
ElseIf Opt24.Checked = True Then
well_number = 24
well_rows = 4
well_cols = 6
End If
ReDim CheckB_Well(well_rows - 1, well_cols - 1)
For rows_C1 = 0 To well_rows - 1
For cols_C1 = 0 To well_cols - 1
CheckB_Well(rows_C1, cols_C1) = New CheckBox
CheckB_Well(rows_C1, cols_C1).Name = "Well" + Str(rows_C1) + ";" + Str(cols_C1)
CheckB_Well(rows_C1, cols_C1).Text = Str(rows_C1) + ";" + Str(cols_C1)
CheckB_Well(rows_C1, cols_C1).Visible = True
If rows_C1 Mod 2 = 0 Then
CheckB_Well(rows_C1, cols_C1).Location = New Point(40 + 50 * cols_C1, 20 + 25 * (well_rows - 1 - rows_C1))
Else
CheckB_Well(rows_C1, cols_C1).Location = New Point(40 + 50 * (well_cols - 1 - cols_C1), 20 + 25 * (well_rows - 1 - rows_C1))
End If
Me.GroupBox3.Controls.Add(CheckB_Well(rows_C1, cols_C1))
Next cols_C1
Next rows_C1
End Sub
You just need to set AutoSize to True:
CheckB_Well(rows_C1, cols_C1) = New CheckBox
CheckB_Well(rows_C1, cols_C1).AutoSize = True
Because it was drawing from left to right on even rows, the extra space from the default size was covering up the CheckBoxes to the right.
Side Note: What is the point of creating the 2D array Dim CheckB_Well(,)? It's a local variable, so it's not necessary:
Sub Check_Panel()
Me.GroupBox3.Controls.Clear()
If Opt6.Checked = True Then
well_number = 6
well_rows = 2
well_cols = 3
ElseIf Opt12.Checked = True Then
well_number = 12
well_rows = 3
well_cols = 4
ElseIf Opt24.Checked = True Then
well_number = 24
well_rows = 4
well_cols = 6
End If
For rows_C1 As Integer = 0 To well_rows - 1
Dim Y As Integer = 20 + 25 * (well_rows - 1 - rows_C1)
For cols_C1 As Integer = 0 To well_cols - 1
Dim CB As New CheckBox
CB.AutoSize = True
CB.Name = "Well" + Str(rows_C1) + ";" + Str(cols_C1)
CB.Text = Str(rows_C1) + ";" + Str(cols_C1)
If rows_C1 Mod 2 = 0 Then
CB.Location = New Point(40 + 50 * cols_C1, Y)
Else
CB.Location = New Point(40 + 50 * (well_cols - 1 - cols_C1), Y)
End If
Me.GroupBox3.Controls.Add(CB)
Next cols_C1
Next rows_C1
End Sub
Output:
I have a little problem with my sub. This sub is calling to different functions, by using the sub's data. The first function finds one is finding the amount of unique values and the second function finds these values. However, the first function works fine because its output is a scalar value. However, the second function's output is an array. I have tried to search for a solution, but so far I have not succeeded. I have a theory that the issue has something to do with the ByRef A() As Integer. I have written the codes below, both for the sub and the second function.
Sub Test()
Dim A() As Integer
Dim n As Integer
Dim BB As Integer
n = 10
ReDim A(n, 2) '5 unikke
A(1, 1) = 1
A(2, 1) = 7
A(3, 1) = 2
A(4, 1) = 6
A(5, 1) = 3
A(6, 1) = 5
A(7, 1) = 1
A(8, 1) = 1
A(9, 1) = 1
A(10, 1) = 4
A(1, 2) = 1
A(2, 2) = 7
A(3, 2) = 2
A(4, 2) = 6
A(5, 2) = 3
A(6, 2) = 5
A(7, 2) = 1
A(8, 2) = 1
A(9, 2) = 1
A(10, 2) = 4
BB = Unikke(A) 'Unikke is the second function that provides the amount of unique values
Dim FF() As Integer
ReDim FF(BB, 1)
FF = HvilkeUnikke(A) 'the second function, which has the output of an array a.k.a the problem
End Sub
This is the function:
Public Function HvilkeUnikke(ByRef A() As Integer) As Integer
Dim L() As Integer
Dim B As Integer
Dim i As Integer
Dim i2 As Integer
Dim A2() As String
Dim BB As Integer
Dim C() As Integer
BB = Unikke(A)
ReDim C(UBound(A), 2)
ReDim A2(BB, 1)
ReDim L(BB, 1)
For i = 1 To UBound(A)
C(i, 1) = A(i, 1)
C(i, 2) = A(i, 2)
Next
For i = 1 To UBound(C)
B = 0
For i2 = 1 To UBound(C)
If C(i, 1) = C(i2, 2) Then
B = B + 1
If B > 1 Then
C(i2, 2) = 0
End If
End If
Next i2
Next i
B = 0
For i2 = 1 To UBound(C)
If C(i2, 2) > 0 Then
B = B + 1
L(B, 1) = C(i2, 2)
End If
Next i2
HvilkeUnikke = L
End Function
The results are as expected, but they should be in a variable inside my sub.
(The solution)
Sub test()
Dim FF() As Integer
Dim i As Integer
Dim A() As Integer
Dim n As Integer
Dim BB As Integer
n = 10
ReDim A(n, 2) '7 unikke
A(1, 1) = 1
A(2, 1) = 7
A(3, 1) = 2
A(4, 1) = 6
A(5, 1) = 3
A(6, 1) = 5
A(7, 1) = 1
A(8, 1) = 1
A(9, 1) = 1
A(10, 1) = 4
A(1, 2) = 1
A(2, 2) = 7
A(3, 2) = 2
A(4, 2) = 6
A(5, 2) = 3
A(6, 2) = 5
A(7, 2) = 1
A(8, 2) = 1
A(9, 2) = 1
A(10, 2) = 4
BB = Unikke(A)
ReDim FF(BB)
FF = HvilkeUnikke(A)
'Testing on the worksheet
For i = 1 To BB
Cells(i, 1) = FF(i)
Next
End Sub
And the function
Public Function HvilkeUnikke(ByRef A() As Integer) As Integer()
Dim L() As Integer
Dim B As Integer
Dim i As Integer
Dim i2 As Integer
Dim A2() As String
Dim BB As Integer
Dim C() As Integer
BB = Unikke(A)
ReDim C(UBound(A), 2)
ReDim A2(BB, 1)
ReDim L(BB)
For i = 1 To UBound(A)
C(i, 1) = A(i, 1)
C(i, 2) = A(i, 2)
Next
For i = 1 To UBound(C)
B = 0
For i2 = 1 To UBound(C)
If C(i, 1) = C(i2, 2) Then
B = B + 1
If B > 1 Then
C(i2, 2) = 0
End If
End If
Next i2
Next i
B = 0
For i2 = 1 To UBound(C)
If C(i2, 2) > 0 Then
B = B + 1
L(B) = C(i2, 2)
End If
Next i2
HvilkeUnikke = L
End Function
For example I have 2d array
tKey(0, 0) = 1
tKey(1, 0) = 2
tKey(2, 0) = 3
So
testArray = Application.Transpose(tKey)
assign like 1D array
testArray(1) = 1
testArray(2) = 2
testArray(3) = 3
Instead of expected
testArray(1,1) = 1
testArray(1,2) = 2
testArray(1,3) = 3
But if tKey
tKey(0, 0) = 1
tKey(1, 0) = 2
tKey(2, 0) = 3
tKey(0, 1) = 1
tKey(1, 1) = 2
tKey(2, 1) = 3
then
testArray = Application.Transpose(tKey)
assign like 2D array, like expected
testArray(1,1) = 1
testArray(1,2) = 2
testArray(1,3) = 3
testArray(2,1) = 1
testArray(2,2) = 2
testArray(2,3) = 3
test code
Sub testss()
Dim tKey(0 To 2, 0 To 0) As Variant
tKey(0, 0) = 1
tKey(1, 0) = 2
tKey(2, 0) = 3
testArray1 = Application.Transpose(tKey) ' wrong assignment
Dim tKey2(0 To 2, 0 To 1) As Variant
tKey2(0, 0) = 1
tKey2(1, 0) = 2
tKey2(2, 0) = 3
tKey2(0, 1) = 1
tKey2(1, 1) = 2
tKey2(2, 1) = 3
testArray2 = Application.Transpose(tKey2) ' good assignment
Stop
End Sub
Is that a bug? How to assign correct one value to 2d array using Application.Transpose?
I wanted to generate 9 random numbers. Then I would get 4 random numbers from that 9, but the four random entries* can't repeat.
There are 28 possible outcomes. The randomizing works fine but I don't understand why I can't get the checkboxes to get checked. I've been trying all day please help
Dim rn As New Random
Dim n(9) As Integer
n(1) = rn.Next(1, 2)
n(2) = rn.Next(1, 3)
n(3) = 1
n(4) = rn.Next(1, 3)
n(5) = 1
n(6) = rn.Next(1, 4)
n(7) = rn.Next(1, 7)
n(8) = rn.Next(1, 4)
n(9) = rn.Next(1, 3)
Dim loopcount As Integer = 4
Dim l(4), ln, lm As Integer
ln = 1
lm = 1
l(1) = rn.Next(1, 9)
l(2) = rn.Next(1, 9)
While l(2) = l(1)
l(2) = rn.Next(1, 9)
End While
l(3) = rn.Next(1, 9)
While l(3) = l(2) Or l(3) = l(1)
l(3) = rn.Next(1, 9)
End While
l(4) = rn.Next(1, 9)
While l(4) = l(3) Or l(4) = l(2) Or l(4) = l(1)
l(3) = rn.Next(1, 9)
End While
MsgBox(l(1) & l(2) & l(3) & l(4))
MsgBox(n(1) & n(2) & n(3) & n(4) & n(5) & n(6) & n(7) & n(8) & n(9))
While loopcount > 0
If ln = 1 Then lm = l(1)
If ln = 2 Then lm = l(2)
If ln = 3 Then lm = l(3)
If ln = 4 Then lm = l(4)
If l(ln) = 1 & n(lm) = 1 Then 1.CheckState = 1
If l(ln) = 1 & n(lm) = 2 Then 2.CheckState = 1
If l(ln) = 2 & n(lm) = 1 Then 3.CheckState = 1
If l(ln) = 2 & n(lm) = 2 Then 4.CheckState = 1
If l(ln) = 2 & n(lm) = 3 Then 5.CheckState = 1
If l(ln) = 3 & n(lm) = 1 Then 6.CheckState = 1
If l(ln) = 4 & n(lm) = 1 Then 7.CheckState = 1
If l(ln) = 4 & n(lm) = 2 Then 8.CheckState = 1
If l(ln) = 4 & n(lm) = 3 Then 9.CheckState = 1
If l(ln) = 5 & n(lm) = 1 Then 10.CheckState = 1
If l(ln) = 6 & n(lm) = 1 Then 11.CheckState = 1
If l(ln) = 6 & n(lm) = 2 Then 12.CheckState = 1
If l(ln) = 6 & n(lm) = 3 Then 13.CheckState = 1
If l(ln) = 6 & n(lm) = 4 Then 14.CheckState = 1
If l(ln) = 7 & n(lm) = 1 Then 15.CheckState = 1
If l(ln) = 7 & n(lm) = 2 Then 16.CheckState = 1
If l(ln) = 7 & n(lm) = 3 Then 17.CheckState = 1
If l(ln) = 7 & n(lm) = 4 Then 18.CheckState = 1
If l(ln) = 7 & n(lm) = 5 Then 19.CheckState = 1
If l(ln) = 7 & n(lm) = 6 Then 20.CheckState = 1
If l(ln) = 7 & n(lm) = 7 Then 21.CheckState = 1
If l(ln) = 8 & n(lm) = 1 Then 22.CheckState = 1
If l(ln) = 8 & n(lm) = 2 Then 23.CheckState = 1
If l(ln) = 8 & n(lm) = 3 Then 24.CheckState = 1
If l(ln) = 8 & n(lm) = 4 Then 25.CheckState = 1
If l(ln) = 9 & n(lm) = 1 Then 26.CheckState = 1
If l(ln) = 9 & n(lm) = 2 Then 27.CheckState = 1
If l(ln) = 9 & n(lm) = 3 Then 28.CheckState = 1
ln = ln + 1
loopcount = loopcount - 1
End While
Call Generate()
I think you need to either rename your check boxes or use square brackets:
[1].CheckState = 1 'for example.
Also, you've used & which should be And...
If l(ln) = 1 & n(lm) = 1 Then 1.CheckState = 1
...should be...
If l(ln) = 1 And n(lm) = 1 Then [1].CheckState = 1
Though this could be shortened to...
[1].CheckState = 1 And (l(ln) = 1) And (n(lm) = 1)