I am building an application which is required to display a random selection of CD music tracks, however an Artist can only appear once in each random selection. I have a table, tbl_tracks which contains an FK link to an Artist table tbl_Artists.
I have a switch in tbl_tracks, IsAvailable which is either True or False. It is False if the CD music track has been played within the last three months, this usage data is stored in a table of Programmes, tbl_Programmes.
Some Artists may have many tracks and a few will only have one track. If they only have one and it is unavailable (IsAvailable = False) then I need to exclude that Artist from the process of generating a random track list
The following code gets me to the point where I have: -
a) A list of Artists who have available Tracks
b) A set of random numbers based on the record count of those Artists
My question is: How do I abstract the ArtistLink from the Recordset, rstRecords using the generated random numbers?
I am imagining that the recordset looks something like this:
Record ArtistLink
(0) (1)
(1) (2)
(2) (4)
ArtistLink (3) is omitted as not available i.e. has only one track and this has been played within the last three months
Assuming I have a 10 random Numbers what I want from the recordset is, the ArtistLink data at 'position' random#1, the ArtistLink data at 'position' random#2 etc.
Code:
Private Sub cmdCreateProgram_Click()
Set dbCurrent = CurrentDb()
'Get a date for the SQL
Dim CutOffDate As Variant
CutOffDate = ThreeMonthDate 'Call to function which returns a date in US format and is 3 months before today's date
'Get the list of tracks which are not available - played in the last 3 months
strSQL = "SELECT TrackLink from tbl_Programmes WHERE DateOfProgramme >= #" & CutOffDate & "#"
Set rstRecords = dbCurrent.OpenRecordset(strSQL, dbOpenDynaset)
'Check if there are tracks which have been used
If Not (rstRecords.EOF And rstRecords.BOF) Then
rstRecords.MoveFirst
'Loop through the records setting availability to false in tbl_Tracks
Do While Not rstRecords.EOF
strSQL = "UPDATE tbl_Tracks SET IsAvailable = False WHERE ID = " & rstRecords!TrackLink
dbCurrent.Execute strSQL, dbFailOnError
rstRecords.MoveNext
Loop
End If
'Tidy Up
Set rstRecords = Nothing
strSQL = ""
Dim NumberOfTracks As Integer
NumberOfTracks = Me.txtNumberOfTracks 'Combo box selection by user on form 10 tracks for half an hour programme, 20 for an hour etc.
Dim recordCount As Integer
Dim ArtistArray As Variant
Dim i As Integer
'Select the available Artists from tbl_Tracks
strSQL = "SELECT DISTINCT ArtistLink FROM tbl_Tracks WHERE IsAvailable = True" 'Some Artists will be missing from this selection because their tracks will not be available
Set rstRecords = dbCurrent.OpenRecordset(strSQL, dbOpenDynaset)
'Create a list of random numbers from 0 to rstRecordcount
recordCount = rstRecords.recordCount
ArtistArray = RandomNumbers(recordCount, 0, NumberOfTracks, True) 'Call to random number generation function. The returned array holds the correct number of Artists
'Check what we have got by way of a debug
For i = LBound(ArtistArray) To UBound(ArtistArray)
Debug.Print ArtistArray(i)
Next i
'All OK...Now I need to extract the ArtistLink from the recordset based on the random number not on the recordsetCount
End Sub
Public Function ThreeMonthDate() As Variant
Dim DateRequired As Variant
'Converts to US format for SQL
DateRequired = Format(DateAdd("m", -3, Date), "mm/dd/yyyy")
ThreeMonthDate = DateRequired
'Debug.Print ThreeMonthDate
End Function
Public Function RandomNumbers(Upper As Integer, Lower As Integer, HowMany As Integer, Unique As Boolean) As Variant
On Error GoTo LocalError
If HowMany > ((Upper + 1) - (Lower - 1)) Then Exit Function
Dim x As Integer
Dim n As Integer
Dim arrNums() As Variant
Dim colNumbers As New Collection
ReDim arrNums(HowMany - 1)
With colNumbers
'First populate the collection
For x = Lower To Upper
.Add x
Next x
For x = 0 To HowMany - 1
n = RandomNumber(0, colNumbers.Count + 1)
arrNums(x) = colNumbers(n)
If Unique Then
colNumbers.Remove n
End If
Next x
End With
Set colNumbers = Nothing
RandomNumbers = arrNums()
Exit Function
LocalError:
'Justin (just in case)
RandomNumbers = ""
End Function
Public Function RandomNumber(Upper As Integer, Lower As Integer) As Integer
'Generates a Random Number BETWEEN the LOWER and UPPER values
Randomize
RandomNumber = Int((Upper - Lower + 1) * Rnd + Lower)
End Function