Random sort with conditions

[christobal]

Require help on the following scenario preferably VBA.

Form generator produces the following layout as registration
order of participants in riding competion( require this layout i
solution)

Clubname Ridername Number Horsename
reading-------Chris----------45---------star
dorking-------Charlie--------22---------rabbit
guildford----- Jane----------34---------loner
reading-------fred-----------67---------star
byfleet--------debby--------32---------gandi
guildford----- ronny-------- 12--------rabbit

This list can contain up to 50 members.
Require random sort of data where the following condition must
be met after random sort -no horse can be used consecutively in
results order where a rest of 2 turns is reuired before being r
entered in list order.

 

[Tom Ogilvy]

a simple solution would be to put in

=rand()
in the 5th column and copy it down. Then you can select the data, including
this column, and do Data=>sort, with the fifth column as the sort key. In
the 6th column you can put in a formula (F2)
=if(or(D2=D3,D2=D4),"Re-sort","")
then drag fill down the column.

Now just keep sorting until you have no resort flag in column F.

You could write a macro that would do this for you.

 

[christobal]

Sounds like a good response but how can this be done as VBA code usin
functions on the range to be checked. I prefer code to copy and past
of formula

 

[Tom Ogilvy]

Sub SortHorses()
Dim rng As Range, rng1 As Range
Set rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
rng.Offset(0, 4).Formula = "=rand()"
rng.Offset(0, 5).Formula = "=if(or(D2=D3,D2=D4),na(),"""")"
Range("E1").Value = "Header5"
Range("F1").Value = "Header6"
Application.Calculate
i = 0
Do
Range("A1").CurrentRegion.Sort Key1:=Range("E2"), _
Order1:=xlAscending, Header:=xlYes
i = i + 1
Set rng1 = Nothing
On Error Resume Next
Set rng1 = rng.Offset(0, 5).SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
Loop While Not rng1 Is Nothing And i < 40
If i = 20 Then
MsgBox "Unsuccessful after 40 sorts"
Else
MsgBox "Successful after " & i & " sorts"
End If
columns("E:F").Delete
End Sub