• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

FAO Narayank991 Luke M [SOLVED]

G

guitarman

Member
Hi Guys

Remember you helped me out with the Macro for selecting numbers for our golf club pairings, well it works brilliantely, but while I am in the office at the computer the Secretary is in the bar watching the draw and was supposed to take down the numbers,But he didn't he said he was facinated by watching the draw so we have no record of the numbers.So I was wondering can I make an alteration to the macro so it can store the numbers in two(2) seperate columns say F---G as this would eliminate this scenario ever happening again.Example as follows

F---G

21 63

87 12

15 125 and so on.

Many Thanks for your Time

Mike
 
Hi Mike ,


No problem ; only since it involves an addition to an existing macro , can you please upload the file that you are using ?


Or can I download the file from your earlier topic ?


Narayan
 
Hi Narayan

Thanks for that here is the macro you created for me

[pre]
Code: 
Public Sub Circular_Lights()
Const HIGHLIGHT = vbBlack  '  Change as required

Dim Number_of_Rows As Long
Dim Number_of_Columns As Long
Dim Row_Selection As Long
Dim Col_Selection As Long
Dim Start_Time As Date
Dim Curr_Time As Date
Dim i As Integer

Dim Data_Range As Range
ThisWorkbook.Worksheets("Sheet1").Activate        '  Change as required
Set Data_Range = ActiveSheet.Range("A1:E50")      '  Change as required

Start_Time = Now

Number_of_Rows = Data_Range.Rows.Count
Number_of_Columns = Data_Range.Columns.Count

Row_Selection = Int(Rnd() * Number_of_Rows)
Col_Selection = Int(Rnd() * Number_of_Columns)
Data_Range.ClearFormats
With Data_Range.Cells(1, 1)
.Offset(Row_Selection, Col_Selection).Interior.Color = HIGHLIGHT
i = 1
Do
DoEvents
Curr_Time = Now
i = i + 1
'Stop flashing? aka, how long do we do running lights
If Curr_Time >= Start_Time + TimeValue("00:00:04") Then
'We have a winner! Highlight all cells except our winner
Data_Range.Cells.Interior.Color = HIGHLIGHT
.Offset(Row_Selection, Col_Selection).Interior.Color = vbYellow

'How long do we wait before resuming?
Application.Wait (Now + TimeValue("00:00:03"))

Data_Range.ClearFormats
.Offset(Row_Selection, Col_Selection).Interior.Color = HIGHLIGHT
Start_Time = Now
i = 1

'Keep on flashing
'5000 picked after experiments. Seems to run at a nice speed.
'Increase to slow down, decrease to speed up
ElseIf i = 10 Then
i = 1

.Offset(Row_Selection, Col_Selection).Interior.Color = xlNone

Row_Selection = Int(Rnd() * Number_of_Rows)
Col_Selection = Int(Rnd() * Number_of_Columns)

'Col_Selection = Col_Selection + 1
'If Col_Selection >= Number_of_Columns Then
'   Col_Selection = 0
'   Row_Selection = Row_Selection + 1
'   If Row_Selection >= Number_of_Rows Then
'      Row_Selection = 0
'   End If
'End If
.Offset(Row_Selection, Col_Selection).Interior.Color = HIGHLIGHT
End If
Loop
End With
End Sub
[/pre]
Many thanks

Mike
 
Hi Mike.

I think we can just add a few lines to record the number each time. How does this work?

[pre]
Code: 
Public Sub Circular_Lights()
Const HIGHLIGHT = vbBlack  '  Change as required

Dim Number_of_Rows As Long
Dim Number_of_Columns As Long
Dim Row_Selection As Long
Dim Col_Selection As Long
Dim Start_Time As Date
Dim Curr_Time As Date
Dim i As Integer

'Two new definitions
Dim gRow As Long
Dim fRow As Long

Dim Data_Range As Range
ThisWorkbook.Worksheets("Sheet1").Activate        '  Change as required
Set Data_Range = ActiveSheet.Range("A1:E50")      '  Change as required

Start_Time = Now

Number_of_Rows = Data_Range.Rows.Count
Number_of_Columns = Data_Range.Columns.Count

Row_Selection = Int(Rnd() * Number_of_Rows)
Col_Selection = Int(Rnd() * Number_of_Columns)
Data_Range.ClearFormats
With Data_Range.Cells(1, 1)
.Offset(Row_Selection, Col_Selection).Interior.Color = HIGHLIGHT
i = 1
Do
DoEvents
Curr_Time = Now
i = i + 1
'Stop flashing? aka, how long do we do running lights
If Curr_Time >= Start_Time + TimeValue("00:00:04") Then
'We have a winner! Highlight all cells except our winner
Data_Range.Cells.Interior.Color = HIGHLIGHT
.Offset(Row_Selection, Col_Selection).Interior.Color = vbYellow

'Store the value in 1 of 2 columns (new code)
fRow = Range("F65536").End(xlUp).Row + 1
gRow = Range("G65536").End(xlUp).Row + 1
If fRow > gRow Then
Cells(fRow, "F").Value = .Offset(Row_Selection, Col_Selection).Value
Else
Cells(gRow, "G").Value = .Offset(Row_Selection, Col_Selection).Value
End If

'How long do we wait before resuming?
Application.Wait (Now + TimeValue("00:00:03"))

Data_Range.ClearFormats
.Offset(Row_Selection, Col_Selection).Interior.Color = HIGHLIGHT
Start_Time = Now
i = 1

'Keep on flashing
'5000 picked after experiments. Seems to run at a nice speed.
'Increase to slow down, decrease to speed up
ElseIf i = 10 Then
i = 1

.Offset(Row_Selection, Col_Selection).Interior.Color = xlNone

Row_Selection = Int(Rnd() * Number_of_Rows)
Col_Selection = Int(Rnd() * Number_of_Columns)

'Col_Selection = Col_Selection + 1
'If Col_Selection >= Number_of_Columns Then
'   Col_Selection = 0
'   Row_Selection = Row_Selection + 1
'   If Row_Selection >= Number_of_Rows Then
'      Row_Selection = 0
'   End If
'End If
.Offset(Row_Selection, Col_Selection).Interior.Color = HIGHLIGHT
End If
Loop
End With
End Sub
[/pre]
 
Hi Luke

Thanks for that just one little problem it lists all the numbers in one column (F). I would like it to give first number in F scond number in G third number in F fourth number in G and so on if that cannot be done no big deal i will have to seperate them manually

Many Thanks

Mike
 
Hi Mike ,

Can you try this ?

[pre]
Code: 
Public Sub Circular_Lights()
Const HIGHLIGHT = vbBlack  '  Change as required

Dim Number_of_Rows As Long
Dim Number_of_Columns As Long
Dim Row_Selection As Long
Dim Col_Selection As Long
Dim Start_Time As Date
Dim Curr_Time As Date
Dim i As Integer, num_count As Integer

'Two new definitions
Dim gRow As Long
Dim fRow As Long

Dim Data_Range As Range
ThisWorkbook.Worksheets("Sheet1").Activate        '  Change as required
Set Data_Range = ActiveSheet.Range("A1:E25")      '  Change as required

Start_Time = Now

Number_of_Rows = Data_Range.Rows.Count
Number_of_Columns = Data_Range.Columns.Count

Row_Selection = Int(Rnd() * Number_of_Rows)
Col_Selection = Int(Rnd() * Number_of_Columns)

fRow = Range("F65536").End(xlUp).Row + 1
gRow = Range("G65536").End(xlUp).Row + 1
num_count = 0

Data_Range.ClearFormats
With Data_Range.Cells(1, 1)
.Offset(Row_Selection, Col_Selection).Interior.Color = HIGHLIGHT
i = 1
Do
DoEvents
Curr_Time = Now
i = i + 1
'Stop flashing? aka, how long do we do running lights
If Curr_Time >= Start_Time + TimeValue("00:00:04") Then
'We have a winner! Highlight all cells except our winner
Data_Range.Cells.Interior.Color = HIGHLIGHT
.Offset(Row_Selection, Col_Selection).Interior.Color = vbYellow
num_count = num_count + 1

'Store the value in 1 of 2 columns (new code)
If num_count Mod 2 <> 0 Then
Cells(fRow, "F").Value = .Offset(Row_Selection, Col_Selection).Value
fRow = fRow + 1
Else
Cells(gRow, "G").Value = .Offset(Row_Selection, Col_Selection).Value
gRow = gRow + 1
End If

'How long do we wait before resuming?
Application.Wait (Now + TimeValue("00:00:03"))

Data_Range.ClearFormats
.Offset(Row_Selection, Col_Selection).Interior.Color = HIGHLIGHT
Start_Time = Now
i = 1

'Keep on flashing
'5000 picked after experiments. Seems to run at a nice speed.
'Increase to slow down, decrease to speed up
ElseIf i = 10 Then
i = 1

.Offset(Row_Selection, Col_Selection).Interior.Color = xlNone

Row_Selection = Int(Rnd() * Number_of_Rows)
Col_Selection = Int(Rnd() * Number_of_Columns)

'Col_Selection = Col_Selection + 1
'If Col_Selection >= Number_of_Columns Then
'   Col_Selection = 0
'   Row_Selection = Row_Selection + 1
'   If Row_Selection >= Number_of_Rows Then
'      Row_Selection = 0
'   End If
'End If
.Offset(Row_Selection, Col_Selection).Interior.Color = HIGHLIGHT
End If
Loop
End With
End Sub
[/pre]
 
Hi Narayan

Fabulous just perfect this will eliminate the use of the (dozy secretary). Once again you come to the rescue my many thanks to you and of course Luke M. May you both have a good day and a brilliant life. Many Thanks

Mike
 
Hi Narayan

Sorry to be a menace. But I decided it would be better if I had 5 columns to record the numbers in so I increased the columns in the macro I then got various messages such as Else without If Loop without Do and the last one is Block If without End if, I am afraid I have not got a clue what all these mean it is obviously something I have done and I only increased the columns from 2 to 5 i.e. added on columns J,K,L to H,I. So I was wondering if you can tell me where I have gone wrong. This is the macro as it stands now.

Many Thanks

Mike

Public Sub Circular_Lights()

Const HIGHLIGHT = vbBlack ' Change as required


Dim Number_of_Rows As Long

Dim Number_of_Columns As Long

Dim Row_Selection As Long

Dim Col_Selection As Long

Dim Start_Time As Date

Dim Curr_Time As Date

Dim i As Integer, num_count As Integer


'Five new definitions

Dim hRow As Long

Dim iRow As Long

Dim jRow As Long

Dim kRow As Long

Dim lRow As Long


Dim Data_Range As Range

ThisWorkbook.Worksheets("Sheet1").Activate ' Change as required

Set Data_Range = ActiveSheet.Range("A1:E50") ' Change as required


Start_Time = Now


Number_of_Rows = Data_Range.Rows.Count

Number_of_Columns = Data_Range.Columns.Count


Row_Selection = Int(Rnd() * Number_of_Rows)

Col_Selection = Int(Rnd() * Number_of_Columns)


hRow = Range("H65536").End(xlUp).Row + 1

iRow = Range("I65536").End(xlUp).Row + 1

jRow = Range("J65536").End(xlUp).Row + 1

kRow = Range("K65536").End(xlUp).Row + 1

lRow = Range("L65536").End(xlUp).Row + 1

num_count = 0


Data_Range.ClearFormats

With Data_Range.Cells(1, 1)

.Offset(Row_Selection, Col_Selection).Interior.Color = HIGHLIGHT

i = 1

Do

DoEvents

Curr_Time = Now

i = i + 1

'Stop flashing? aka, how long do we do running lights

If Curr_Time >= Start_Time + TimeValue("00:00:04") Then

'We have a winner! Highlight all cells except our winner

Data_Range.Cells.Interior.Color = HIGHLIGHT

.Offset(Row_Selection, Col_Selection).Interior.Color = vbYellow

num_count = num_count + 4

'Store the value in 1 of 5 columns (new code)

If num_count Mod 5 <> 0 Then

Cells(hRow, "H").Value = .Offset(Row_Selection, Col_Selection).Value

hRow = hRow + 1

If num_count Mod 5 <> 0 Then

Else

Cells(iRow, "I").Value = .Offset(Row_Selection, Col_Selection).Value

iRow = iRow + 1

If num_count Mod 5 <> 0 Then

Else

Cells(jRow, "J").Value = .Offset(Row_Selection, Col_Selection).Value

jRow = jRow + 1

If num_count Mod 5 <> 0 Then

Else

Cells(kRow, "K").Value = .Offset(Row_Selection, Col_Selection).Value

kRow = kRow + 1

If num_count Mod 5 <> 0 Then

Else

Cells(lRow, "L").Value = .Offset(Row_Selection, Col_Selection).Value

lRow = lRow + 1

End If

'How long do we wait before resuming?

Application.Wait (Now + TimeValue("00:00:03"))


Data_Range.ClearFormats

.Offset(Row_Selection, Col_Selection).Interior.Color = HIGHLIGHT

Start_Time = Now

i = 1


'Keep on flashing

'5000 picked after experiments. Seems to run at a nice speed.

'Increase to slow down, decrease to speed up

If k = 10 Then

k = 1


.Offset(Row_Selection, Col_Selection).Interior.Color = xlNone


Row_Selection = Int(Rnd() * Number_of_Rows)

Col_Selection = Int(Rnd() * Number_of_Columns)


'Col_Selection = Col_Selection + 1

'If Col_Selection >= Number_of_Columns Then

' Col_Selection = 0

' Row_Selection = Row_Selection + 1

' If Row_Selection >= Number_of_Rows Then

' Row_Selection = 0

' End If

'End If

.Offset(Row_Selection, Col_Selection).Interior.Color = HIGHLIGHT

End If

Do

Loop

End

End Sub
 
Hi Mike ,


Sorry , but there's been a mixup in allotting the numbers to the proper columns.


When you had the numbers going into just two columns , it was very easy ; using the MOD function , the result would be either 0 or 1 ; the first number would have 1 MOD 2 , which would give 1 as the result ; the second number would have 2 MOD 2 , which would give 0 as the result , and so on. Every odd number would result in a 1 , and every even number would result in a 0.


These two cases could be taken care of by a single IF ... THEN ... ELSE ... ENDIF statement.


Now that you want the numbers to be allotted to 5 columns , the easier solution ( compared to using IF ... THEN ... ELSE statements ) would be to use the SELECT CASE statement. Even easier would be to use a MOD 5 result as an OFFSET parameter , in which case just one statement will do.


Either Luke or I or anyone else , for that matter , will post the revised code shortly.


Narayan
 
Hi Narayan

Thanks for looking at that I thought it would be me messing it up I am pretty good at that. Anyway if it is a lot of bother do not put yourself out I will resort back to the 2 columns, but if you can do it, it would be very much appreciated. I tend to get backache very much sat down at a keyboard because I have a disadvantage bent over for a long time because I am 6'8" and it is a long way to bend down. Anyway I will leave it in your capable hands one way or another.

Many Thanks for your Time

Mike
 
Hi Mike ,

Try this :

Public Sub Circular_Lights()
Const HIGHLIGHT = vbBlack ' Change as required

Dim Number_of_Rows As Long
Dim Number_of_Columns As Long
Dim Row_Selection As Long
Dim Col_Selection As Long
Dim Start_Time As Date
Dim Curr_Time As Date
Dim i As Integer, num_count As Integer

'Two new definitions
Dim fRow As Long, gRow As Long, hRow As Long, iRow As Long, jRow As Long

Dim Data_Range As Range
ThisWorkbook.Worksheets("Sheet1").Activate ' Change as required
Set Data_Range = ActiveSheet.Range("A1:E50") ' Change as required

Start_Time = Now

Number_of_Rows = Data_Range.Rows.Count
Number_of_Columns = Data_Range.Columns.Count

Row_Selection = Int(Rnd() * Number_of_Rows)
Col_Selection = Int(Rnd() * Number_of_Columns)

fRow = Range("F65536").End(xlUp).Row + 1
gRow = Range("G65536").End(xlUp).Row + 1
hRow = Range("H65536").End(xlUp).Row + 1
iRow = Range("I65536").End(xlUp).Row + 1
jRow = Range("J65536").End(xlUp).Row + 1

num_count = 0

Data_Range.ClearFormats
With Data_Range.Cells(1, 1)
.Offset(Row_Selection, Col_Selection).Interior.Color = HIGHLIGHT
i = 1
Do
DoEvents
Curr_Time = Now
i = i + 1
'Stop flashing? aka, how long do we do running lights
If Curr_Time >= Start_Time + TimeValue("00:00:04") Then
'We have a winner! Highlight all cells except our winner
Data_Range.Cells.Interior.Color = HIGHLIGHT
.Offset(Row_Selection, Col_Selection).Interior.Color = vbYellow
num_count = num_count + 1

'Store the value in 5 columns (new code)
' -----------------------------------------------------------------------------------
Select Case num_count Mod 5
Case 1:
Cells(fRow, "F").Value = .Offset(Row_Selection, Col_Selection).Value
fRow = fRow + 1
Case 2:
Cells(gRow, "G").Value = .Offset(Row_Selection, Col_Selection).Value
gRow = gRow + 1
Case 3:
Cells(hRow, "H").Value = .Offset(Row_Selection, Col_Selection).Value
hRow = hRow + 1
Case 4:
Cells(iRow, "I").Value = .Offset(Row_Selection, Col_Selection).Value
iRow = iRow + 1
Case 0:
Cells(jRow, "J").Value = .Offset(Row_Selection, Col_Selection).Value
jRow = jRow + 1
End Select
' -----------------------------------------------------------------------------------
'How long do we wait before resuming?
Application.Wait (Now + TimeValue("00:00:03"))

Data_Range.ClearFormats
.Offset(Row_Selection, Col_Selection).Interior.Color = HIGHLIGHT
Start_Time = Now
i = 1

'Keep on flashing
'5000 picked after experiments. Seems to run at a nice speed.
'Increase to slow down, decrease to speed up
ElseIf i = 10 Then
i = 1

.Offset(Row_Selection, Col_Selection).Interior.Color = xlNone

Row_Selection = Int(Rnd() * Number_of_Rows)
Col_Selection = Int(Rnd() * Number_of_Columns)

'Col_Selection = Col_Selection + 1
'If Col_Selection >= Number_of_Columns Then
' Col_Selection = 0
' Row_Selection = Row_Selection + 1
' If Row_Selection >= Number_of_Rows Then
' Row_Selection = 0
' End If
'End If
.Offset(Row_Selection, Col_Selection).Interior.Color = HIGHLIGHT
End If
Loop
End With
End Sub

Narayan
 
Hi Narayan

Brilliant just how I want it now,its a good job I can rely on you to get me out of the mire, still I tried. Once again my sincere Thanks for your time and help. May you have a good day and a brilliant life.

Many Thanks

Mike
 
You must log in or register to reply here.
Back
Top