Macro Help

[Dan Wilson]

Good day. Grab a cold one, this will take a while to explain. I have a Worksheet titled “Random Picks” with a Macro that creates 40 individual random numbers and guarantees that none of the 40 numbers are duplicates. In another Workbook titled “50-69” there is a worksheet that lists 3500 songs that are in my music folder. That same worksheet contains a Column that tracks the last time each song was used in my weekly podcast. This is done so that no songs are repeated in a 6-week time period. On the “Random Picks” Worksheet there is also a list of the 40 random numbers in Cells B8 thru B47. Cell N8 is changed each week to contain the most recent Podcast Number. At this point each of the values found in Cells B8 thru B47 are examined by comparing the value found with the value found in N8 with a value of 6 subtracted from the most recent Podcast. For example, the value in N8 may be 90, thus the number being compared to the values in B8 thru B47 would be 84. If the value found in B8 thru B47 is less than the comparison number, the Cell in K8 thru K47 would be left blank. If the value found is 84 or higher, the word “bad” is placed in the Cell in Column K for that comparison. Cell N11 then counts the word “bad” found in Cells K8 thru K47. On the “Random Picks” worksheet there is a Macro that causes the random numbers to be generated in the first place. I would like to alter that Macro so that when it executes the random number generation continuously until Cell N11 contains a zero. I have tried to make a test Macro, but I’m not having much luck. Any help will be appreciated.

 

[Macropod]

It might help if you posted the code you're using. Otherwise, it's impossible for anyone to see what changes might be needed.

At its simplest you might use something like:

Sub Demo()
With Sheets("Random Picks")
  Do While .Range("N11").Value <> 0
    Application.Calculate
  Loop
End With
End Sub

replacing 'Application.Calculate' with a call to the sub that actually does the random number generation.

 

[Dan Wilson]

It might help if you posted the code you're using. Otherwise, it's impossible for anyone to see what changes might be needed.

At its simplest you might use something like:

Sub Demo()
With Sheets("Random Picks")
  Do While .Range("N11").Value <> 0
    Application.Calculate
  Loop
End With
End Sub

replacing 'Application.Calculate' with a call to the sub that actually does the random number generation.

Good day Macropod and thank you for responding. Let's try a different approach. Copied below is the formula that creates a random number between 1 and 3009 in each of the Cells from Row 3 (A3 thru AN3) of the worksheet "Random Picks". The formula guarantees that are no duplicates in the 40 numbers chosen. There are currently 3009 songs in my music folder and that number is extracted from another workbook where the total count is stored and automatically updated.

=TAKE(SORTBY(SEQUENCE(1,C1),RANDARRAY(1,C1)),,40)

Below are the two Macros that monitor and copy the numbers selected above. The "Copy_Random_Numbers" Macro copies the numbers found in Row 3 into the spaces in Row 4. After using the Macros, I discovered that there is no need to run the "Get_Random_Numbers" Macro as running the "Copy_Random_numbers" Macro causes everything in Row 3 to be changed. Cell AO3 labels Row 3 as "Actual" numbers found and Cell AO4 labels Row 4 as "Hold".

Sub Get_Random_Numbers()
'
' Copy_Random_Numbers Macro
' get random numbers and check for bad
'
'
Calculate
Range("A6").Select
End Sub


Sub Copy_Random_Numbers()
'
' Copy_Random_Numbers Macro
' copy random numbers into hold
'
'
Range("A3:AN3").Select
Selection.Copy
Range("A4:AN4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A6").Select
Application.CutCopyMode = False
End Sub

Here is an explanation of the lower part of the "Random Picks" worksheet. The area covers rows 8 thru 47 and Columns A thru N. Column A numbers the song selections from 1 to 40. Column B contains a LOOKUP function that pulls the Podcast Number of the last time that song was played from another Workbook. Columns C thru J are merged to show the song title accessed by an INDEX function. to another Workbook. Cell N8 contains the most recent Podcast number that is manually changed weekly. Cells K8 thru K47 contain the formula
=IF(B8>$N$8-10,"bad","")
where the 8 in B8 is incremented in each row to determine if each next song has been played in the last 10 Podcasts. Cell N11 then uses the formula
=COUNTIF(K8:K47,"bad")
to count the number of "bad" found. The goal of all this is to repeat the "Copy_Random_Numbers" Macro until Cell N11 contains a zero, meaning that all of the songs chosen have not been used in the most recent 10 Podcasts. I hope this helps. I tried using your suggestion, but could not get it to work. Thank you for any help.

 

[Snakehips]

@Dan Wilson
Below is an example of how you might wish to approach this in a way that does not require iterations to eliminate the 'bad' tunes?
Maybe copy the below to a blank workbook and test the basic principle?
I only have the picks and tunes data in separate sheets but they could easily be in separate workbooks.
Each run of the code should provide a valid play list.

Sub PickTunes()

Dim lsttr As Long
Dim tunes As Worksheet
Dim randrng As Range

Set tunes = Sheets("50-69")  'Tunes data

lsttr = tunes.Range("A" & Rows.Count).End(xlUp).Row 'last tune row
Set randrng = tunes.Range("F2:F" & lsttr)

randrng.Formula = "=IF(B2>'Random Picks'!$C$3-10,99999,RAND())"
randrng = randrng.Value

End Sub

TunePicker.xlsm
	A	B	C	D
1
2
3		This PodCast#	57
4
5
6		Playlist
7	Tune #	Title
8	1	Title30
9	2	Title5
10	3	Title10
11	4	Title48
12	5	Title28
13	6	Title51
14	7	Title16
15	8	Title4
16	9	Title40
17	10	Title59
18	11	Title56
19	12	Title58
20	13	Title11
21	14	Title18
22	15	Title24
23	16	Title34
24	17	Title9
25	18	Title27
26	19	Title19
27	20	Title20
28	21	Title32
29	22	Title29
30	23	Title55
31	24	Title25
32	25	Title54
33	26	Title12
34	27	Title26
35	28	Title23
36	29	Title8
37	30	Title6
38	31	Title1
39	32	Title44
40	33	Title57
41	34	Title2
42	35	Title17
43	36	Title31
44	37	Title35
45	38	Title3
46	39	Title22
47	40	Title60
48
Random Picks

Cell Formulas
Range	Formula
B8:B47	B8	=INDEX('50-69'!A2:A5000,MATCH(A8:A47,'50-69'!G2:G5000,0))
Dynamic array formulas.

TunePicker.xlsm
	A	B	C	D	E	F	G
1	Title	Last Played				Code generated Random #	Rank
2	Title1	14				0.760649026	31
3	Title2	15				0.785903371	34
4	Title3	16				0.849162107	38
5	Title4	17				0.145029593	8
6	Title5	18				0.013254411	2
7	Title6	19				0.738297814	30
8	Title7	20				0.936806825	43
9	Title8	21				0.732239105	29
10	Title9	42				0.531930933	17
11	Title10	23				0.025863926	3
12	Title11	24				0.313803202	13
13	Title12	25				0.692409825	26
14	Title13	26				0.948035086	45
15	Title14	65				99999	99999
16	Title15	28				0.914155925	41
17	Title16	29				0.093490153	7
18	Title17	30				0.810317442	35
19	Title18	31				0.347395619	14
20	Title19	32				0.554261886	19
21	Title20	33				0.556729593	20
22	Title21	34				0.924466956	42
23	Title22	35				0.893304563	39
24	Title23	36				0.726794036	28
25	Title24	37				0.396146413	15
26	Title25	38				0.643080525	24
27	Title26	39				0.705509928	27
28	Title27	40				0.550003837	18
29	Title28	41				0.078550452	5
30	Title29	16				0.598070475	22
31	Title30	43				0.0060718	1
32	Title31	44				0.826151921	36
33	Title32	45				0.578460645	21
34	Title33	46				0.943090903	44
35	Title34	47				0.474698884	16
36	Title35	17				0.843469478	37
37	Title36	49				99999	99999
38	Title37	50				99999	99999
39	Title38	51				99999	99999
40	Title39	62				99999	99999
41	Title40	22				0.171946629	9
42	Title41	60				99999	99999
43	Title42	59				99999	99999
44	Title43	58				99999	99999
45	Title44	12				0.77505712	32
46	Title45	56				99999	99999
47	Title46	55				99999	99999
48	Title47	54				99999	99999
49	Title48	25				0.042089182	4
50	Title49	52				99999	99999
51	Title50	51				99999	99999
52	Title51	13				0.092784464	6
53	Title52	49				99999	99999
54	Title53	48				99999	99999
55	Title54	47				0.67091442	25
56	Title55	10				0.627075344	23
57	Title56	45				0.204099375	11
58	Title57	44				0.77991456	33
59	Title58	43				0.260559674	12
60	Title59	42				0.202066327	10
61	Title60	41				0.913551144	40
62
50-69

Cell Formulas
Range	Formula
G2:G5000	G2	=IFERROR(IF(F2:F5000=99999,99999,RANK(F2:F5000,F$2:F$5000,1)),"")
Dynamic array formulas.

HTH

 

[Dan Wilson]

@Dan Wilson
Below is an example of how you might wish to approach this in a way that does not require iterations to eliminate the 'bad' tunes?
Maybe copy the below to a blank workbook and test the basic principle?
I only have the picks and tunes data in separate sheets but they could easily be in separate workbooks.
Each run of the code should provide a valid play list.

Sub PickTunes()

Dim lsttr As Long
Dim tunes As Worksheet
Dim randrng As Range

Set tunes = Sheets("50-69")  'Tunes data

lsttr = tunes.Range("A" & Rows.Count).End(xlUp).Row 'last tune row
Set randrng = tunes.Range("F2:F" & lsttr)

randrng.Formula = "=IF(B2>'Random Picks'!$C$3-10,99999,RAND())"
randrng = randrng.Value

End Sub

[/QUOTE]

Good Snakehips and thank you for responding. I’m not sure what happened, but your response leads me to believe that you think I want to check every song and remove those that come up “bad”. The Macros that are now in place work fine. All I want to do is modify the Macro so that if the count of “bad” is more than zero, to recall the Macro over and over until the count is zero. I’m sorry for the confusion. I must have rewritten my response several times until I thought I covered all the details.

EDIT: Moderator removed reply from quote.

 

[Snakehips]

^^^^ Your response appears to have got absorbed into the quote above but I have managed to read it.
Apologies if I have misinterpreted. I had imagined that you were looking to compile a random list of 40 tunes that had not been broadcast during the last 10 podcasts?

 

[Dan Wilson]

Good day again Snakehips and thank you for responding. I am confused. Your response "you were looking to compile a random list of 40 tunes that had not been broadcast during the last 10 podcasts" is correct. However, after looking at your solution (which I don't understand), I realized that my explanation of the problem was missing something. I am not experienced enough with Excel to completely understand the steps you wrote. I'm sure that it would work, but my level of expertise with Excel does not convince me that I would understand what is going on. I appreciate the effort you put into your response and I'm sorry that I don't understand it. At this point I am executing the "Copy Random Numbers" Macro over and over until the "bad" count is zero. Since all of that works, it seems that the easiest fix is to alter the Macro so that if the "bad" count is not zero, the Macro will run again until the count is zero. I wish I had the knowledge and experience that people such as yourself have. Thank you and I hope that you understand.

 

[Snakehips]

@Dan Wilson Hi Dan, give this alternative code a try.

Sub Copy_Random_Numbers()
'
' Copy_Random_Numbers Macro
' copy random numbers into hold
' repeat until zero "bad'
'
Application.ScreenUpdating = False  'disable screen updating to aid speed and visuals

Msg = "Sorry - Tr1ed But Failed"
For try = 1 To 3000   'set top limit of trys in order to avoid any danger of infinite looping

    Range("A4:AN4") = Range("A3:AN3").Value 'copy latest randoms
    If Range("N11") = 0 Then
        Msg = "Done"
        GoTo Done 'quit loop if 'bad' count is zero
    End If
Next try   'otherwise try again
    
Range("A6").Select

'Point of exit
Done:
Application.ScreenUpdating = True  'reset screen updating
MsgBox Msg
End Sub

 

[Dan Wilson]

Good day again Snakehips and CONGRATULATIONS! Your recent response allowed me to understand what is happening and with a couple modifications, it now works! Below is the Macro as modified. I especially l like the ScreenUpdating function. I had a terrible time making i t work until I realized that Cell N11 should have been N14 as I swapped Cells N11 and N14. There really is no reason to run 3000 trys, so I cut it down to 300. Thank you for sticking with this one. I appreciate the extra effort and your patience.

Sub Copy_Random_Numbers()
'
' Copy_Random_Numbers Macro
' Copy random numbers and check for bad - stop on zero count
'
Application.ScreenUpdating = false
msg = "Sorry - failed"
For try = 1 To 3000
'
Range("a4:an4") = Range("a3:an3").Value
If Range("N14") = 0 Then
msg = "Done"
GoTo done
End If
Next try
Range("a6").Select
done:
Application.ScreenUpdating = True
msg = "Sorry - failed"
MsgBox msg
'
End Sub