randomize, grouping, copying

[sulie]

hi,
i have 2644 data students in excel, i want to run a macro to randomize
their names, and then put them into new worksheet, with all their
details, such as their age, birthday, address and etc, which are
located in different columns, but same rows as the names. here the
macro function that i use to randomize the name into new worksheet, but
it only return the students names. how to include other columns too?

Sub ExtractRandom20()
Dim tmp As Collection
Dim rngSrc As Range
Dim rngTgt As Range
Dim r&


Set rngSrc = Worksheets(2).Range("a2:a2645")
Set rngTgt = Worksheets(1).Range("a1:a2644")

Randomize

Set tmp = New Collection
On Error Resume Next
With rngSrc
While tmp.Count < rngTgt.Rows.Count
r = Int(Rnd * .Rows.Count + 1)
tmp.Add .Cells(r, 1).Value, CStr(r)
Wend
End With

For r = 1 To tmp.Count
rngTgt(r, 1) = tmp(r)
Next

End Sub


n any idea how to grouping the students into 100 groups?(which
estimately 28 persons per group)


thanks for any idea..

 

[Nick Hebb]

Arbitrarily picking "D" as the last column I came up with the
following:

With Worksheets("Sheet2")
' change the following line for your actual last column
Worksheets("Sheet1").Range("A22645").Copy
Destination:=.Range("B1:E2644")
.Range("A1").FormulaR1C1 = "=RAND()"
.Range("A1").AutoFill Destination:=.Range("A1:A2644")
' the following 2 lines are optional to avoid recalc of rand()'s
.Range("A1:A2644").Copy
.Range("A1:A2644").PasteSpecial Paste:=xlPasteValues
' change the following line for your actual last column
.Range("A1:E2644").Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlYes
.Columns("A:A").Delete Shift:=xlToLeft
End With

Also, I replaced the ordinal numbering for the worksheets to some
codenames, i.e., "Sheet1" and "sheet2". Change this as needed. Using
ordinal numbers (e.g. Worksheets(1)) can lead to problems if sheets are
added, deleted, or re-ordered.

 

[Tushar Mehta]

The best way to do this is to leverage the XL object model not work
around it.

Given any number of rows of data the best way to randomize the order is
to add a column with =RAND() in it. Sort using this new column and
delete the column.

In your case, the way to do this by hand would be:

Select the currentregion of cell A2 in the source sheet. Copy to the
destination sheet. Add a new column of random numbers, sort, and
delete this column.

I recorded those actions with Tools | Macro > Record new macro... to
get Macro1 below. Then, I cleaned it up to get testIt2.

Option Explicit

Sub Macro1()
Range("A2").Select
Selection.CurrentRegion.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
Range("H1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RAND()"
Range("H1").Select
Selection.AutoFill Destination:=Range("H1:H4")
Range("H1:H4").Select
Range("A1:H4").Sort Key1:=Range("H1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.ClearContents
End Sub
Sub testIt2()
Dim SrcSheet As Worksheet, DestSheet As Worksheet, _
FreeCell As Range
Set SrcSheet = ActiveWorkbook.Worksheets(1)
Set DestSheet = ActiveWorkbook.Worksheets(2)
With DestSheet
SrcSheet.Range("A2").CurrentRegion.Copy .Range("a1")
Set FreeCell = .Range("a1").End(xlToRight).Offset(0, 1)
End With
With FreeCell
.FormulaR1C1 = "=RAND()"
.AutoFill _
Destination:=DestSheet.Range( _
.Offset(0, -1), .Offset(0, -1).End(xlDown)).Offset(0, 1)
DestSheet.Range("A1").CurrentRegion.Sort Key1:=FreeCell, _
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
FreeCell.EntireColumn.Delete
End With
End Sub

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions