I want to display random different possibilities from a specific data table. I am trying to grab random unique (cannot be used more than once) IDs from column "A" (about 100 IDs in this field), and making sure criteria is met from columns "B" and "C"(Usually only whole number or .5 decimal numbers).
Example list below, but very shortened format. I want to have total number (column "C") equal 19.5 or 20, and have:
- Red from column "B" to be > 5 in column "C".
- Green from column "B" have at least 2 in column "C"
- Yellow from column "C" cannot be more than 7 in column "C"
I want it so that every time I press a button, it will have another random possibility to fit specific criteria.
ID | Colour | Number |
---|---|---|
111 | Red | 1.5 |
112 | Blue | 2 |
113 | Green | 1 |
114 | Blue | 1.5 |
115 | Yellow | 2 |
116 | Blue | 1 |
I have been trying to freestyle with the little knowledge that I have and have the below so far. I am not sure if I am going in the right direction.
Sub RandomPossibilities()
Dim NoOfIDs As Long
Dim RandomNumber As Integer
Dim IDs(), Colour() As String
Dim i As Byte
Dim CellsOut As Long
Dim ArI As Byte
Dim RedCount, BlueCount, YellowCount, GreenCount, TotalCount As Variant
Application.ScreenUpdating = False
RedCount = 0
BlueCount = 0
GreenCount = 0
YellowCount = 0
TotalCount = 0
CellsOut = 6
ReDim IDs(1 To 20)
ReDim Colour(1 To 20)
NoOfIDs = Application.CountA(Range("A:A")) - 1
i = 1
Do Until (TotalCount = 20 Or TotalCount = 19.5) And RedCount >= 5 And GreenCount >= 2 And YellowCount <= 7
RandomNo:
RandomNumber = Application.RandBetween(2, NoOfIDs + 1)
For ArI = LBound(IDs) To UBound(IDs)
If IDs(ArI) = Cells(RandomNumber, 1).Value Then
GoTo RandomNo
End If
If Cells(RandomNumber, 2).Value = "Not Available"
GoTo RandomNo
End If
Next ArI
IDs(i) = Cells(RandomNumber, 1).Value
Colour(i) = Cells(RandomNumber, 2).Value
If Cells(RandomNumber, 2).Value = "Red" Then
RedCount = RedCount + Cells(RandomNumber, 3).Value
ElseIf Cells(RandomNumber, 2).Value = "Yellow" Then
YellowCount = YellowCount + Cells(RandomNumber, 3).Value
ElseIf Cells(RandomNumber, 2).Value = "Blue" Then
BlueCount = BlueCount + Cells(RandomNumber, 3).Value
ElseIf Cells(RandomNumber, 2).Value = "Green" Then
GreenCount = GreenCount + Cells(RandomNumber, 3).Value
End If
If TotalCount = 20 Or TotalCount = 19.5 Then
If RedCount >= 5 Then
i = 0
RedCount = 0
BlueCount = 0
GreenCount = 0
YellowCount = 0
TotalCount = 0
End If
If GreenCount >= 2 Then
i = 0
RedCount = 0
BlueCount = 0
GreenCount = 0
YellowCount = 0
TotalCount = 0
End If
If YellowCount <= 7 Then
i = 0
RedCount = 0
BlueCount = 0
GreenCount = 0
YellowCount = 0
TotalCount = 0
End If
End If
If TotalCount >= 9 Then
If RedCount >= 5 Then
i = 0
RedCount = 0
BlueCount = 0
GreenCount = 0
YellowCount = 0
TotalCount = 0
End If
If GreenCount >=2 Then
i = 0
RedCount = 0
BlueCount = 0
GreenCount = 0
YellowCount = 0
TotalCount = 0
End If
If YellowCount <=7 2 Then
i = 0
RedCount = 0
BlueCount = 0
GreenCount = 0
YellowCount = 0
TotalCount = 0
End If
i = 0
RedCount = 0
BlueCount = 0
GreenCount = 0
YellowCount = 0
TotalCount = 0
End If
i = i + 1
TotalCount = GreenCount + BlueCount + YellowCount + RedCount
Loop
For ArI = LBound(IDs) To UBound(IDs)
Cells(CellsOut + 2, 6) = IDs(ArI)
Cells(CellsOut + 2, 7) = Colour(ArI)
CellsOut = CellsOut + 1
Next ArI
Cells(8, 9) = YellowCount
Cells(9, 9) = BlueCount
Cells(10, 9) = GreenCount
Cells(11, 9) = RedCount
Cells(12, 9) = TotalCount
Application.ScreenUpdating = True
End Sub
Aucun commentaire:
Enregistrer un commentaire