Help is needed for modifying this code.

  • Thread starter Thread starter Patrick Molloy
  • Start date Start date
P

Patrick Molloy

1) get the cell values (2) randomise (3) sort (4) replace

Sub RandomSelectetion()
Dim Values() As Variant ' tpo hold the values
' and the random numbers
Dim index As Long ' for/next counter
Dim index2 As Long ' for sorting
Dim temp As String ' for sorting
Dim Target As Range
Dim cell As Range

Randomize Timer ' re-initialise the randomiser

Set Target = Selection
ReDim Values(1 To Target.Count, 1 To 2)

' get the selected cell values and assign a RND number

index = 0
For Each cell In Target
index = index + 1
Values(index, 1) = cell.Value
Values(index, 2) = Rnd
Next


'simple sort
For index = 1 To Target.Count - 1

For index2 = index + 1 To Target.Count
If Values(index, 2) > Values(index2, 2) Then
temp = Values(index, 1)
Values(index, 1) = Values(index2, 1)
Values(index2, 1) = temp
End If
Next
Next

' push back to spreadsheet
index = 0
For Each cell In Target
index = index + 1
cell.Value = Values(index, 1)
Next

End Sub
 
Hi,

I have a problem with an excel macro and seek help from this helpful
newsgroup.
The below code accomplishes a task of drawing random numbers (upto 20) on a
spesific column (A1:A20).
I need to modify it such that; the randomizing is applicable to "any"
selected region of the sheet. Furthermore although the limits are set, the
below code picks "random" numbers each time it is executed. This means that
there may be "new" numbers drawn and some left out on each new attempt. But
I need to "restrict" the randomizing process to pre-filled and "selected"
cell contents only. It should be able to randomize "text" as well as
numbers. For examle if I have selected A1, B20, K44, E3, F11 which has the
below info as content:

A1="hello"
B20=345
K44="12.10.2004"
E3=TRUE
F11=-2

After the macro is executed the content of the cells should be changed
randomly such as:

A1="12.10.2004"
B20=TRUE
K44="hello"
E3=-2
F11=345

After the macro is executed again the content of the cells may look like
this:

A1=-2
B20="hello"
K44=345
E3="12.10.2004"
F11=TRUE

New execution of the macro should only move the pre-written content around
the selected cells.
I think I have made my problem clear enough...

Although I look forward from answers of NG experts Tom Ogilvy, Ron de Bruin,
Bob Philips and Frank Kabel especially, help is appreciated from all...

'==============================
Option Explicit

Private Sub CommandButton1_Click()
Dim varrRandomNumberList As Variant
varrRandomNumberList = UniqueRandomNumbers(20, 1, 20)
Range(Cells(1, 1), Cells(20, 1)).Value = _
Application.Transpose(varrRandomNumberList)
End Sub
'====================================
Option Explicit

Function UniqueRandomNumbers(NumCount As Long, LLimit As Long, ULimit As
Long) As Variant

Dim RandColl As Collection, i As Long, varTemp() As Long
UniqueRandomNumbers = False
If NumCount < 1 Then Exit Function
If LLimit > ULimit Then Exit Function
If NumCount > (ULimit - LLimit + 1) Then Exit Function
Set RandColl = New Collection
Randomize
Do
On Error Resume Next
i = CLng(Rnd * (ULimit - LLimit) + LLimit)
RandColl.Add i, CStr(i)
On Error GoTo 0
Loop Until RandColl.Count = NumCount
ReDim varTemp(1 To NumCount)
For i = 1 To NumCount
varTemp(i) = RandColl(i)
Next i
Set RandColl = Nothing
UniqueRandomNumbers = varTemp
Erase varTemp
End Function
'==================================

Sincerely
J_J
 
Back
Top