Hi,

I already have a basic random number generator code (which i'd posted in one of the earlier posts to this thread), but the thing i wonder is how can any number of row(s) be copied from a filtered sheet of records directly? I mean, is it possible to atleast copy one row with filters applied to (without removing the filter from) the sheet?

After spending much time browsing, I finally came to know that by referencing the autofilter's visible range by using the AutoFilter.Range.SpecialCells(xlCellTypeVisible) property, i can pick out rows from a filtered range of data from a worksheet.

My basic random number generator code can generate random numbers on a sheet (in a separate column) and can copy and transfer the required number of rows (input by the user) based on random selection to a separate sheet. This code works fine without filters applied, but i need to make it work when filters exist in the sheet.

My code is as below:
[vba]
' Extracts requested records from a database by random selection.
' The list must be properly organized, without blank rows or columns, but may or ' may not have one header row.
' 1. Open and activate the file with records from which random data has to be chosen

' 2. Click Extract Samples button on the Extract menu
Option Explicit
Sub ExtractRandom()
Dim NumToExtract As Long
Dim NumRows As Long
Dim msg, style, title, response
Dim DataSheet As Worksheet
Dim wsExtract As Worksheet
msg = "This macro will extract the requested number of records" _
& vbCrLf & "from a list by random selection. It assumes there are" _
& vbCrLf & "no blank rows or columns in your list, and the list" _
& vbCrLf & "starts in cell A1. If this is NOT the case, click CANCEL" _
& vbCrLf & "and fix things."
style = vbOKCancel
title = "Are you ready?"
response = MsgBox(msg, style, title)
If response = vbCancel Then Exit Sub
Set DataSheet = ActiveSheet
msg = "Does your list have a header row (Column headings)?"
style = vbYesNo
title = "Headers?"
response = MsgBox(msg, style, title)
NumRows = DataSheet.Range("A1").CurrentRegion.Rows.Count
NumToExtract = InputBox("How many records do you want to extract?")
'Mark records with current row number for resorting at end of macro
With DataSheet
.Columns("A:A").Insert Shift:=xlToRight
.Range("A1:A" & NumRows).FormulaR1C1 = "=ROW()-1"
.Range("A1:A" & NumRows).Value _
= .Range("A1:A" & NumRows).Value
End With
'Create random number for each record & sort by random number
If response = vbYes Then
With DataSheet
.Columns("A:A").Insert Shift:=xlToRight
.Range("A1").Value = "Rand"
.Range("A2:A" & NumRows).FormulaR1C1 = "=RAND()"
End With
Application.Calculation = xlCalculationManual
With DataSheet
.Range("A1").Sort Key1:=.Range("A2"), _
Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
.Range("A2").Value = "1"
.Range("A2").AutoFill _
Destination:=.Range("A2:A" & NumRows), Type:=xlFillSeries
End With
Else
With DataSheet
.Columns("A:A").Insert Shift:=xlToRight
.Range("A1:A" & NumRows).FormulaR1C1 = "=RAND()"
End With
Application.Calculation = xlCalculationManual
With DataSheet
.Range("A1").Sort Key1:=.Range("A1"), _
Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
.Range("A1").Value = "1"
.Range("A1").AutoFill _
Destination:=.Range("A1:A" & NumRows), Type:=xlFillSeries
End With
End If
'Advanced filter extracts records numbered to number requested
Set wsExtract = Sheets.Add
wsExtract.Range("B2").FormulaR1C1 = "=RC[-1]<=" & NumToExtract
' This line of code below extracts sample records from the source sheet to a new sheet
DataSheet.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=wsExtract.Range("B1:B2"), _
CopyToRange:=wsExtract.Range("A4"), Unique:=False
With wsExtract
.Rows("1:3").Delete Shift:=xlUp
.Columns("A:B").Delete
.Name = "Extracted_" & NumToExtract & "_RandomRecords"
End With
'Restore records to original order
DataSheet.Range("B1").Sort Key1:=DataSheet.Range("B1"), _
Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
DataSheet.Columns("A:B").Delete
Application.Calculation = xlCalculationAutomatic
End Sub
[/vba]

I came across an article in one of the many other online forums on Excel for generating non-repeating random numbers.

It had a discussion about 2 basic methods for creating non-recurring random numbers.
  • Generate a random number. Check it against a list of numbers already generated. If it exists, get another one. If it does not, add it to the list.
  • Generate a list of all possible numbers, in sequence. Use the random number generator to mix them up.
Both methods have their advantages and disadvantages and the method used depends upon the situation on hand. For example, If you are shuffling a deck of cards, you would use the second method. Otherwise, as the number of available cards diminishes, you spend most of your time generating invalid entries. Conversely, if you were generating positions of objects in a large universe, you would use the first method since you aren't going to generate all possible values, just a few.

It also discussed on a piece of code to demonstrate the above two methods:
[vba]
Private Function CreateRandom(ByVal num As Long, ByVal min As Long, ByVal max As Long) As Variant
'Returns an array of numbers between where min <= x < max
'Returns NULL if there is a problem
Dim aValues() As Long
Dim i As Long, x As Long, span As Long, j As Long, bFound As Boolean
span = max - min + 1
If (span > num) And (num > 0) Then
ReDim aValues(num - 1)
For i = 0 To num - 1
Do
x = Int(Rnd() * span) + min
bFound = False
For j = 0 To i - 1
If x = aValues(j) Then bFound = True: Exit For
Next j
Loop While bFound
aValues(i) = x
Next i
CreateRandom = aValues
Else
CreateRandom = Null
End If
End Function

Private Function ShuffleArray(aData As Variant) As Boolean
'shuffles array adata. Returns true unless there is a problem
Dim max As Long
Dim i As Long, j As Long, v As Variant

If IsArray(aData) Then
max = UBound(aData)
For i = max To 1 Step -1
j = Int(Rnd() * (i + 1)) 'pick one to switch
If i <> j Then
v = aData(i)
aData(i) = aData(j)
aData(j) = v
End If
Next i
ShuffleArray = True
End If
End Function
[/vba]

I need to tweak my code (merge the above codes together) and make it work when there are filters applied to the workbook (filter maybe applied to one or more columns) and i want to set these filter automatically.

This is most trickiest part in my code, for which i'm trying to find a solution which is still elusive.
Can this be done? Can anybody teach / help me how to go about coding for this?

I'll be extremely grateful for any help that i can get.

Ranga