i am working in vb.net and trying to organise what i'm calling a meal/entree break .
the code i have looks right to me but it just isn't working.
it is supposed to find entree's then mains then all else and print in that order but
it prints the results in order of clicked instead of in the order i've defined.
to keep in mind, i am using a reference to a vb6 code "powerpack" to use old school print codes that i'm more comfortable.
i have assigned some public shared variables:
Public Shared item(25) As String
Public Shared bar(25) As String
Public Shared price(25) As Integer
Public Shared barprice(25) As Integer
Public Shared EntreeBreak(25) As Boolean
Public Shared MainBreak(25) As Boolean
Public Shared Print_Items(25) As String
Public Shared Print_price(25) As Integer
i then have created a global class that i call public shared subs from, the sub i am calling is
Dim i2 As Integer
i = 1
i2 = 1
Do Until i = 26
If item(i) <> "" Then
If EntreeBreak(i) = True And i2 < 26 Then
Print_Items(i2) = item(i)
Print_price(i2) = price(i)
i2 = i2 + 1
ElseIf MainBreak(i) = True And i2 < 26 Then
Print_Items(i2) = item(i)
Print_price(i2) = price(i)
i2 = i2 + 1
ElseIf EntreeBreak(i) = False And MainBreak(i) = False And i2 < 26 Then
Print_Items(i2) = item(i)
Print_price(i2) = price(i)
i2 = i2 + 1
End If
End If
i = i + 1
Loop
i just can't find what i'm doing wrong
it is supposed to find entree's then mains then all else but
it prints the results in order of clicked instead of in the order i've defined.
You are just looping through item in order from 1 to 26
I am assuming item has a mix of entrees, mains and all else, so perhaps what you need to do is loop through the item three times, firstly extracting the entrees, then the mains, then all else.
Having said that i would encourage you to use a better data structure, possible an ordered dictionary and meal class/structure or something. and as said above you should be looping from 0 to 25, or if it is a dictionary or a list , just a for each will do.
Related
So I have a data set that is made up of a variety tag numbers - I'm trying to develop a VBA "fucntion" to basically give recommendation on a tag number when inputting a new one. This would be easy but the current list gives gaps within tag numbers (eg) goes 4001 4002 4005 . This bit of code is taking that gap and storing "option" tags which I plan to display to the user (so 4003 and 4004). The problem is that these gaps are encountered more than once eg) 4001 4002 4005 4006 4007 4011 4012 and when it comes to the second gap (4008 4009 4010) it overwrites the existing array - how can I get it take each gap and then begin the array below that?
My code is as follows:
For j = 2 To UBound(strArrayNumber)
If strArrayNumber(j) <> strArrayNumber(j - 1) + 1 Then
Gap = strArrayNumber(j) - strArrayNumber(j - 1)
For b = 1 To Gap
ReDim TagOptions(1 To Gap) As Integer
TagOptions(b) = strArrayNumber(j - 1) + b
sh.Cells(b, 6) = TagOptions(b)
Next b
End If
At the prompting of #JohnSUN here is the bare bones of a solution using Scripting.Dictionary.
The OP desires to manage a data set. To simplify this management I have chosen to create a TagList object. The TagList object allows
Population of the tag list from two arrays
Updating the value associated with a tag item
getting back an array of tags or object
getting an array of the next free tags
testing if a tag exists
This is a bare bones example as it is designed to point the way rather than provide a complete solution. It has some obvious ommisions, i.e. there is no code for what happens if a the request for the next set of free tags uses a tag that is higher then the maximum tag number, there is no error code for what happens if we try to add an existing tag to the TagList etc.
The Class Taglist code compiles without error and shows no significant inospection results after a Rubberduck code inspection
Class TagList
Option Explicit
Private Type State
' Requires a reference to 'Microsoft Scripting Runtime'
TagList As Scripting.Dictionary
End Type
Private s As State
Private Sub Class_Initialize()
Set s.TagList = New Scripting.Dictionary
End Sub
Public Property Get Item(ByVal iptag As Long) As Variant
Item = s.TagList.Item(iptag)
End Property
Public Property Let Item(ByVal iptag As Long, ByVal ipitem As Variant)
s.TagList.Item(iptag) = ipitem
End Property
Public Function Tags() As Variant
Tags = s.TagList.keys
End Function
Public Function Items() As Variant
Items = s.TagList.Items
End Function
Public Sub Add(ByVal ipTags As Variant, Optional ByVal ipItems As Variant)
'ipTags and ipItems should be arrays of equal size
If IsMissing(ipItems) Then
ReDim ipItems(UBound(ipTags) - LBound(Tags) + 1)
End If
If (UBound(ipTags) - LBound(ipTags)) - (UBound(ipItems) - LBound(ipItems)) <> 0 Then
Err.Raise vbObjectError + 512, "Size Error", "Arrays are different sizes"
End If
Dim myItemsIndex As Long
myItemsIndex = LBound(ipItems)
Dim myTag As Variant
For Each myTag In ipTags
s.TagList.Add myTag, CVar(ipItems(myItemsIndex))
myItemsIndex = myItemsIndex + 1
Next
End Sub
Public Function Exists(ByVal iptag As Long) As Boolean
Exists = s.TagList.Exists(iptag)
End Function
Public Function NextFreeTags(ByVal iptag As Long) As Variant
If iptag < 1 Then
Err.Raise vbObjectError + 512, "Negative Tag", "Tag numbers must be positive"
End If
Dim myFreeTags As Scripting.Dictionary
Set myFreeTags = New Scripting.Dictionary
Do While s.TagList.Exists(iptag)
iptag = iptag + 1
Loop
Do Until s.TagList.Exists(iptag)
myFreeTags.Add iptag, iptag
iptag = iptag + 1
Loop
NextFreeTags = myFreeTags.keys
End Function
Thus we can now do the following
Dim myTagList as TagList
Set myTagList = New TagList
mytaglist.Add Array(4006, 4001, 4002, 4011, 4005, 4007)
' Note the above is the short form version we could equally say
' myTagList.add Array(4006, 4001, 4002, 4011, 4005, 4007), Array(Obj6, Obj1, Obj11, Obj5, Obj7)
'Oops, we forgot to add tag 4012
myTaglist.add array(4012)
' getting then next free tags
dim myTags as variant
myTags = myTaglist.NextFreeTags(4001)
etc
Let's not calculate the Gap. The parameters of the cycle by B can be any - we will use this. Try this:
Set oCell = sh.Range("F1")
TagOptions = Array()
For j = 2 To UBound(strArrayNumber)
If strArrayNumber(j) <> strArrayNumber(j - 1) + 1 Then
For b = strArrayNumber(j - 1) + 1 To strArrayNumber(j) - 1
uBoundTagOptions = UBound(TagOptions) + 1
ReDim Preserve TagOptions(1 To uBoundTagOptions)
TagOptions(uBoundTagOptions) = b
oCell.Value = b
Set oCell = oCell.Offset(1, 0)
Next b
End If
Next j
Don't forget to specify Option Base 1 at the beginning of the module, otherwise TagOptions = Array() will create an empty array [0..-1] , with LBound = 0, but you want from LBound = 1
UPDATE
By the way, there is one old trick using an auxiliary array. This is used to clear data from duplicates, for sorting and other things. The method is resource-intensive, but very fast. It looks something like this:
Function getGaps(aData As Variant) As Variant
Dim lB As Long, uB As Long, i As Long, lCount As Long
Dim aTemp() As Boolean, aResult() As Long
If IsArray(aData) Then
lB = Application.WorksheetFunction.Min(aData)
uB = Application.WorksheetFunction.Max(aData)
Rem Let's create an auxiliary array of boolean flags. It may be very large, but it won't be long.
ReDim aTemp(lB To uB)
Rem Let's mark in the array those values ??that are in the aData.
Rem In this case, we will skip duplicates, if any, and count the number of unique numbers.
lCount = 0
For i = LBound(aData) To UBound(aData)
If Not aTemp(aData(i)) Then
aTemp(aData(i)) = True
lCount = lCount + 1
End If
Next i
Rem Number of values in gaps:
uB = uB - lB - lCount + 1
If uB > 0 Then ' It may be that there were no gaps in the array
ReDim aResult(1 To uB)
lCount = 0
For i = LBound(aTemp) To UBound(aTemp)
If Not aTemp(i) Then
lCount = lCount + 1
aResult(lCount) = i
End If
Next i
Rem Here it is - the result of the function
getGaps = aResult
Rem The interpreter will destroy this variable immediately after exiting the function,
Rem but will free the memory a little later. This line should help free memory faster
ReDim aTemp(0)
End If
End If
Rem In all other cases, the function will return Empty
End Function
Despite the number of lines, it is very simple and very fast since all the work is done in RAM.
With this function, all the code you showed in your question becomes:
Set oCell = sh.Range("F1")
oCell.EntireColumn.ClearContents ' This is for the case where no gaps are found
TagOptions = getGaps(strArrayNumber)
If IsEmpty(TagOptions) Then
Debug.Print "No gaps in array"
Exit Sub
End If
oCell.Resize(UBound(TagOptions), 1).Value2 = Application.WorksheetFunction.Transpose(TagOptions)
Of course TRANSPOSE () might not work correctly for a very large array. But I hope that you are not so cruel to your users and the list of possible tags does not exceed a hundred or two.
I have a list of objects and I'm trying to sort by two properties with one property being sorted by a custom order. The list has properties of ReqType and PartNumber. ReqType will be "M", "B", "S", or null and I would like to sort the list in that order. Then sort by PartNumber.
Input list:
PartNumber ReqType
124 B
125 M
123 B
121 S
120 M
115
Expected Sort:
PartNumber ReqType
120 M
125 M
123 B
124 B
121 S
115
I started with the code below but that only sorts ReqType alphabetically.
Return EBom.OrderBy(Function(f) f.ReqType).ThenBy(Function(f) f.PartNumber).ToList
I then found a method to create a custom sort order using the code below. Though using Ebom.Sort() doesn't seem to allow me to tack on the second sort order for PartNumber. I realize I could probably add the PartNumber sorting to the custom function but that seems like a lot of work.
EBom.Sort()
Return EBom.ToList
Implements IComparable(Of EBomList)
Public Function SortReq(other As EBomList) As Integer Implements IComparable(Of EBomList).CompareTo
If (Me.ReqType = other.ReqType) Then
Return 0
ElseIf (Me.ReqType = "M") Then
Return -1
ElseIf (Me.ReqType = "B") Then
If (other.ReqType = "M") Then
Return 1
Else
Return -1
End If
ElseIf (Me.ReqType = "S") Then
If (other.ReqType = "M" Or other.ReqType = "B") Then
Return 1
Else
Return -1
End If
Else
Return 1
End If
End Function
Is there an easier way to sort by a custom order or at least combine the custom sort function with a .thenby(.....) to get the order I'd like?
Cleaner code version to do this is to use a Function in the sort method like the following.
d.Sort(Function(X As EBomList, Y As EBomList)
Dim Tx As Integer = InStr("MBS ", X.ReqType.PadLeft(1, " "c))
Dim Ty As Integer = InStr("MBS ", Y.ReqType.PadLeft(1, " "c))
Select Case Tx
Case Is < Ty : Return -1
Case Is > Ty : Return 1
Case Else : Return X.PartNumber.CompareTo(Y.PartNumber)
End Select
End Function)
Note it only needs to check the partnumber when the type code is the same.
I am assuming your Partnumber is in fact a number. If it is a string you will need to pad it as appropriate. For example.
Return X.PartNumber.PadLeft(6," "c).CompareTo(Y.PartNumber.PadLeft(6," "c))
ALTERNATIVE AND FASTER APPROACH
If you have A LOT of data you may want to consider augmenting the EBomLit to create a sort key rather than doing that string search though...
As in...
Private _ReqType As String
Private _TypeKey As Integer
Public Property ReqType As String
Get
Return _ReqType
End Get
Set(value As String)
_ReqType = value
_TypeKey = InStr("MBS ", value.PadLeft(1, " "c))
End Set
End Property
Public ReadOnly Property TypeKey As Integer
Get
Return _TypeKey
End Get
End Property
Then the sort becomes...
d.Sort(Function(X As EBomList, Y As EBomList)
Select Case X.TypeKey
Case Is < Y.TypeKey : Return -1
Case Is > Y.TypeKey : Return 1
Case Else : Return X.PartNumber.CompareTo(Y.PartNumber)
End Select
End Function)
FASTER STILL
You could even extend that further by creating a full sort key out of the "TypeKey" with the padded "PartNumber" and use those as a key to save the whole shebang in a SortedDictionary instead of a List.
Just create a list of ReqTypes and lookup the index:
Dim sortOrder = "MBS "
Dim sortedList = List.OrderBy(Function(x) sortOrder.IndexOf(If(x.ReqType Is Nothing, " ", x.ReqType))).ThenBy(Function(x) x.PartNumber).ToList()
Note: If sorting by something other than chars then you will need to create a propper array/list of the object to compare by.
A bit easier with Enum and Tuple if those are an option:
Enum PartNumber As Byte : M : B : S : __ : End Enum
Dim list = New List(Of Tuple(Of PartNumber, Integer)) From {
Tuple.Create(PartNumber.B, 124),
Tuple.Create(PartNumber.M, 125),
Tuple.Create(PartNumber.B, 123),
Tuple.Create(PartNumber.S, 121),
Tuple.Create(PartNumber.M, 120),
Tuple.Create(PartNumber.__, 115)}
list.Sort()
For Each item In list
Debug.Print(item.Item2 & vbTab & item.Item1.ToString.Replace("_", ""))
Next
Output:
120 M
125 M
123 B
124 B
121 S
115
I just have a very simple question regarding vba.
I understand that a static variable in vba keeps its previous value rather then reseting it each time the function is called. However, I was wondering how could I have a "static function" rather than a variable. Let me clarify this with a simple code:
Function Alt(Soc1 As Double)
Static D As Integer
If Soc1 >= 40 Then
Alt = 0
ElseIf Soc1 <= 30 Then
Alt = 1
End If
End Function
Here I would like the variable-function Alt to keep its previous value so that I get a sort of "hysteresis" behaviour. However if I add:
Static Alt As Integer
I get an error when calling the function Alt().
Also if I add a line such as:Alt = D while D is decalred as static I get an alternating value of Alt (1,0,1,0,1,0 ..) instead of (1,1,1,1) if active or (0,0,0,0) if not.
How should I tackle this simple issue? Any help would be appreciated.
Thank you in advance!
If I've got you, not sure it does what you need. :)
Option Explicit
Public intReturnToHold As Double
Sub call_function()
Debug.Print Alt(2, intReturnToHold)
End Sub
Function Alt(Soc1 As Double, Optional ByRef intHoldAlt)
Static D As Integer
Alt = intReturnToHold
If Soc1 >= 40 Then
Alt = 0
ElseIf Soc1 <= 30 Then
Alt = 1
End If
intHoldAlt = Alt
End Function
Thank you Nathan for your answer. Altough I don't really understand your code I believe I get the idea of it but it did not work.
I have tried my previous idea again and for some reason it worked this time, here is the code;
Function Alt(Soc1 As Double)
Static D As Integer
If Soc1 >= 40 Then
D = 0
ElseIf Soc1 <= 30 Then
D = 1
End If
Alt = D
End Function
I have previously tired the EXACT same code and the results were as I said in my question "alternating" between 1 and 0 (when active) but now are constant 1 (when active).
I'm not 100% sure what you are asking, but if you want a function to compute just once and then retain its value, you could do something like this:
Function Alt(Soc1 As Double) As Long
Static D As Long
Static Called As Boolean
If Called Then
Alt = D
Exit Function
End If
If Soc1 >= 40 Then
D = 0
ElseIf Soc1 <= 30 Then
D = 1
End If
Called = True
Alt = D
End Function
On the other hand, if your goal is to have a function which, once it takes on the value 1 never resets to 0, something like this would work:
Function Alt(Soc1 As Double) As Long
Static D As Long
If D = 1 Then
Alt = D
Exit Function
End If
If Soc1 >= 40 Then
D = 0
ElseIf Soc1 <= 30 Then
D = 1
End If
Alt = D
End Function
I am trying to build a random sample and random assignment generator for a website I am working on that is supposed to assign randomly selected items in an equal number to a variable set of people.
For example:
In this round of assessment, we have 9 assessors, and 477 items that need to be graded by two assessors each (with the same assessor not grading the same item twice). This would come out to 954 total "assessments" that need to be made, and 106 per assessor.
Therefore I'd need an eventual list like...
(Item, Assessor1, Assessor2)
(1, A, B)
(2, C, D)
(3, E, F)
(4, G, H)
(5, H, B)
(6, B, F)
.
.
.
And so on
I've found websites that can do random number generation and even some that can do random assignment over groups, but even then I am still finding situations where the same assessor will be grading the same item throughout the results.
I am less concerned about the inherent randomness and more concerned about making sure each result list has every assessor grading the same number of items without grading the same one.
I can usually get it to the point where I have it -close- and maybe one grader will be 1 or 2 more and another will be 1 or 2 less, but unfortunately it's a hard requirement that they be equal groupings.
EDIT
Implemented #Tinstaafl's code and ran the following:
Dim col As New MyItemCollection
col.AddAssessor("A")
col.AddAssessor("B")
col.AddAssessor("C")
col.AddAssessor("D")
col.AddAssessor("E")
col.AddAssessor("F")
col.AddAssessor("G")
col.AddAssessor("H")
col.AddAssessor("I")
For I As Integer = 1 To 477
col.AddItem(I.ToString)
Next
Dim newList As List(Of MyItemCollection.MyItem) = col.AssignAssessors
For Each item As MyItemCollection.MyItem In col.itemlist
Response.Write(item.ToString & "<br/>")
Next
Unfortunately my output looks like
1 - F - F
2 - I - I
3 - E - E
4 - F - F
5 - C - C
6 - D - D
7 - G - G
8 - A - A
9 - C - C
10 - B - B
11 - D - D
12 - D - D
13 - D - D
14 - D - D
15 - H - H
And so on...
One idea that I can think of is as follows:
Shuffle the assessors {1-9}. Then assign the first 4.5 items to them sequentially as per the result of this shuffle.
Then shuffle them again. Again assign them sequentially to the next items. If the first assessor happens to be the same one that is already assigned to the 5th item, then swap the 1st and second assessor in the list.
Keep doing this for all items.
One way is with a collection class and embedded classes for the items and assessors. Here's a partial implementation to show how the list could be generated:
Public Class MyItemCollection
Class Assessor
Public Name As String = ""
Public Shared Operator <>(LH As Assessor, RH As Assessor) As Boolean
Return LH.Name <> RH.Name
End Operator
Public Shared Operator =(LH As Assessor, RH As Assessor) As Boolean
Return RH.Name = LH.Name
End Operator
Public Overrides Function ToString() As String
Return Name
End Function
End Class
Class MyItem
Public Name As String = ""
Public Assessor1 As New Assessor
Public Assessor2 As New Assessor
Public Overrides Function ToString() As String
Return Name & " - " & Assessor1.ToString & " - " & Assessor2.ToString
End Function
End Class
Private AssessorList As New List(Of Assessor)
Private ItemList As New List(Of MyItem)
Public Sub AddAssessor(Name As String)
AssessorList.Add(New Assessor With {.Name = Name})
End Sub
Public Sub AddItem(Name As String)
ItemList.Add(New MyItem With {.Name = Name})
End Sub
Private Rnd As New Random(Now.Millisecond * Now.Day * Now.Minute)
Public Function AssignAssessors() As List(Of MyItem)
Dim OutVal As New List(Of MyItem)
Dim average As Integer = ((ItemList.Count \ AssessorList.Count) * 2) + 5
Dim AssessorCount(AssessorList.Count - 1) As Integer
For Each item As MyItem In ItemList
Dim firstassessorindex As Integer
Do
firstassessorindex = Rnd.Next(0, AssessorList.Count)
Loop Until AssessorCount(firstassessorindex) <= average
item.Assessor1 = AssessorList(firstassessorindex)
AssessorCount(firstassessorindex) += 1
Dim secondassessorindex As Integer
Do
secondassessorindex = Rnd.Next(0, AssessorList.Count)
Loop Until AssessorList(secondassessorindex) <> item.Assessor1 AndAlso AssessorCount(secondassessorindex) < average
item.Assessor2 = AssessorList(secondassessorindex)
AssessorCount(secondassessorindex) += 1
Next
OutVal = ItemList
Return OutVal
End Function
End Class
One thing that wasn't clear in your explanation was if the distribution between Assessor1 and Assessor2 is important(does it matter if an assessor is the second assessor more times than it is the first?). If you need that, then a List(Of Tuple(Integer, Integer)) might be needed for the AssessorCount instead of a List(Of Integer)
The ToString method for each item in the return list will be in the format -
ItemName - Assessor1Name - Assessor2Name
I'm not sure if I understand your assignment rules, but this might be close.
var assessors = new []
{
"A", "B", "C",
"D", "E", "F",
"G", "H", "I",
};
var rnd = new Random();
var query =
from a1 in assessors
from a2 in assessors
where a1 != a2
orderby rnd.Next()
select new { a1, a2};
var results =
Enumerable
.Range(1, 477)
.Zip(query
.Repeat(),
(i, aa) => new
{
Item = i,
Assessor1 = aa.a1,
Assessor2 = aa.a2,
});
I get this kind of result:
1 F B
2 E C
3 D H
...
476 F C
477 B E
This code generates a stack overflow. I'm aware it is caused by the procedure calling itself.
What can I do to avoid the stack overflow? Recalling the sub procedure and generating a new random number is the easiest thing to do, however it generates the overflow. The randomly generated number picks a random inventory item, then the if statement matches that number (random inventory item) with the quantity of that item from the deck inventory to make sure it isn't less than 1. If the inventory of that item is 0, the else plays and restarts the procedure, generating a new random number and doing the process all over again. In another procedure I have a function that if the deck's inventory becomes completely empty, then the discard pile replenishes the deck, making the discard pile empty, so there should never be a case where all randomly generated numbers can be associated item with a inventory of 0.
I wonder if I could somehow force the random number generator
Number = (DeckGroup(Rnd.Next(0, DeckGroup.Count)).ID)
not to generate numbers to inventory items DeckGroup(Number).QuantityInteger that are zero. By doing so I wouldn't even need to recall the function.
The random number is generated by a different branch in the same structure group.
Private Sub PlayElse()
Dim CardCheckBoxArray() As CheckBox = {CardCheckBox1, CardCheckBox2, CardCheckBox3, CardCheckBox4, CardCheckBox5}
'Reset Number Generator
Number = (DeckGroup(Rnd.Next(0, DeckGroup.Count)).ID)
Dim PlayerQuantitySubtractionInteger As Integer
For PlayerQuantitySubtractionInteger = ChecksDynamicA To ChecksDynamicB
If CardCheckBoxArray(TextBoxInteger).Checked = True And DeckGroup(Number).QuantityInteger > 0 Then
DeckGroup(Number).QuantityInteger -= 1
'Select the Player depending value of T
Select Case T
Case 0
Player1HandGroup(Number).QuantityInteger += 1
Case 1
Player1HandGroup(Number).QuantityInteger2 += 1
Case 2
Player1HandGroup(Number).QuantityInteger3 += 1
Case 3
Player1HandGroup(Number).QuantityInteger4 += 1
Case 4
Player1HandGroup(Number).QuantityInteger5 += 1
End Select
CardTypeArray(PlayerQuantitySubtractionInteger) = Player1HandGroup(Number).CardType
CardCheckBoxArray(TextBoxInteger).Text = Player1HandGroup(Number).CardNameString
NumberArray(PlayerQuantitySubtractionInteger) = Number
Else
If CardCheckBoxArray(TextBoxInteger).Checked = True And DeckGroup(Number).QuantityInteger < 0 Then
Call PlayElse()
End If
End If
Next PlayerQuantitySubtractionInteger
End Sub
You could use LINQ to weed out all the objects you never want to get first and then use the collection returned by the linq instead of your original collection.
Something like:
Private Sub PlayElse()
Dim CardCheckBoxArray() As CheckBox = {CardCheckBox1, CardCheckBox2, CardCheckBox3, CardCheckBox4, CardCheckBox5}
'Reset Number Generator
Dim temp As IEnumerable(Of LunchMoneyGame.LunchMoneyMainForm.Group) = From r In DeckGroup Where r.QuantityInteger > 0 Select r
If temp IsNot Nothing AndAlso temp.Any Then
Number = (temp(Rnd.Next(0, temp.Count)).ID)
' ** Edit **: This will ensure that you only got 1 object back from the LINQ which can tell you whether or not you have bad data. You *can* exclude this check but its good practice to include it.
Dim obj As LunchMoneyGame.LunchMoneyMainForm.Group = Nothing
Dim t = From r In temp Where r.ID = Number Select r
If t IsNot Nothing AndAlso t.Count = 1 Then
obj = t(0)
End If
If obj IsNot Nothing Then
Dim PlayerQuantitySubtractionInteger As Integer
For PlayerQuantitySubtractionInteger = ChecksDynamicA To ChecksDynamicB
' ** Edit **
obj.QuantityInteger -= 1
'Select the Player depending value of T
Select Case T
Case 0
Player1HandGroup(Number).QuantityInteger += 1
Case 1
Player1HandGroup(Number).QuantityInteger2 += 1
Case 2
Player1HandGroup(Number).QuantityInteger3 += 1
Case 3
Player1HandGroup(Number).QuantityInteger4 += 1
Case 4
Player1HandGroup(Number).QuantityInteger5 += 1
End Select
CardTypeArray(PlayerQuantitySubtractionInteger) = Player1HandGroup(Number).CardType
CardCheckBoxArray(TextBoxInteger).Text = Player1HandGroup(Number).CardNameString
NumberArray(PlayerQuantitySubtractionInteger) = Number
Next PlayerQuantitySubtractionInteger
End If
End If
End Sub
Pass through the list and determine only those that are valid. Then randomly pull from that set. Here is a simple version of it. You could use LINQ as well, but this should be clear enough:
Dim validDeckGroupsIndexes As New List(Of Integer)
For ndx As Integer = 0 to DeckGroup.Count - 1
If DeckGroup(ndx).QuantityInteger > 0 Then
validDeckGroupsIndexes .Add(ndx)
End If
Next ndx
Then use this:
Dim deckGroupNdx As Integer = Rnd.Next(0, validDeckGroupsIndexes.Count)
Number = DeckGroup(deckGroupNdx).ID