Random selection of rows.

[chavan2000 via OfficeKB.com]

Hi,

I have a database of 10000 rows in excel and i want a macro which will select
10%(10% of 10000 rows) of rows randomly and paste it in a different sheet.

And if a user mentions a specific number, say 1150 rows then the macro should
select those many rows randomly and paste it in a different sheet.

I dont know how to use the rand() function in VBA. Can sum one help me with
the code.
I am not a programmer

Regards
Heera

 

[Joel]

Sub Randrows()

'Set sheet where data is located
Set DataSht = Sheets("Sheet1")
'set column where random numbe is placed
RandCol = "X"
'initialized random generator
Randomize


With DataSht
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NumRows = InputBox("Enter Number of Rows (1 to " & LastRow & ") to Get")

For RowCount = 1 To LastRow
.Range("X" & RowCount) = Rnd()
Next
'sort data by random number generator
.Rows("1:" & LastRow).Sort _
key1:=.Range("X1"), _
order1:=xlAscending, _
header:=xlNo

Set newsht = Sheets.Add(after:=Sheets(Sheets.Count))
If NumRows > LastRow Then
NumRows = LastRow
End If
.Rows("1:" & NumRows).Copy _
Destination:=newsht.Rows(1)
End With

 

[Bernie Deitrick]

Heera,

Assuming that your data starts in A1, try the macro below.

HTH,
Bernie
MS Excel MVP


Sub SelectRandomSample()
Dim mySh1 As Worksheet
Dim mySh2 As Worksheet
Dim myR As Long

Set mySh1 = ActiveSheet
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Random Selection").Delete
Application.DisplayAlerts = True
Set mySh2 = Worksheets.Add
mySh2.Name = "Random Selection"

mySh1.Cells.Copy mySh2.Cells

mySh2.Range("A1").EntireColumn.Insert
mySh2.Range("A1").Value = "Randomize"
myR = mySh2.Cells(Rows.Count, 2).End(xlUp).Row
mySh2.Range("A2:A" & myR).FormulaR1C1 = "=RAND()"
Range("A1").CurrentRegion.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

If MsgBox("Keep 10%? ""No"" to select number.", vbYesNo) = vbYes Then
Rows(myR / 10).Resize(myR).EntireRow.Delete
Else
Rows(InputBox("How many rows to keep?") + 2).Resize(myR).EntireRow.Delete
End If
mySh2.Range("A1").EntireColumn.Delete
End Sub