Copy x number of random rows from filtered range

sharky12345

Well-known Member
Joined
Aug 5, 2010
Messages
3,421
Office Version
  1. 2016
Platform
  1. Windows
Hi Guys,

I'm trying to find a way using VBA to copy a specified number of random rows from a filtered range.

I've scrambled this together so far

VBA Code:
LastNumber = WorksheetFunction.Subtotal(103, wb.Sheets(2).Range("A2:A5000")) 
NumberToImport = ComboRecords.Value
MaxNumber = LastNumber - NumberToCreate

myRnd = Int(2 + Rnd * (MaxNumber - 2 + 1))

StartRow = myRnd
EndRow = myRnd + NumberToImport

wb.Sheets(2).Range("D" & StartRow & ":D" & EndRow).SpecialCells(xlCellTypeVisible).Copy

It works, sort of - it copies the correct amount of random cells but not from the visible range.

Could someone help me understand why, or indeed provide a far better solution?
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
wb.Sheets(2).Range("D" & StartRow & ":D" & EndRow).SpecialCells(xlCellTypeVisible).Copy
From what I can see, you are copying values from column D


or indeed provide a far better solution?
The next solution has another approach.

First, the macro gets the visible row numbers.
For example, out of 20 records, 7 are visible (2, 4, 6, 8, 10, 11, 12); the data in cells D2="blue", D4="red", D6="white", D8="yellow", D10="black", D11="green", D12="pink" and stores that data in a matrix 'b'​
Continuing with the example:
In position 1 of the array it stores the"blue".​
In position 2 of the array it stores the "red".​
In position 3 the "white".​
In the 4 the "yellow".​
In the 5 the "black".​
In the 6 the "green".​
And in the 7 the "pink".​

Then, from those 7 numbers (visibles), the macro gets n random numbers, for example ComboRecords = 3.

Second, the macro obtains 3 random numbers between 1 and 7. Are 6, 1 and 4.
Then the macro takes the data contained in positions 6, 1 and 4.​

Result:
"green", "blue", "yellow".​

VBA Code:
Private Sub CommandButton1_Click()
  Dim wb As Workbook
  Dim sh As Worksheet
  Dim lr&, i&, j&, k&, n&, x&, y&, z&
  Dim a As Variant, b As Variant, arr As Variant, m As Variant
 
  Set wb = ThisWorkbook
  Set sh = wb.Sheets(2)
 
  'gets the visible row numbers.
  lr = sh.Range("D" & Rows.Count).End(3).Row
  ReDim b(1 To lr, 1 To 1)
  For i = 2 To lr
    If sh.Rows(i).Hidden = False Then
      k = k + 1
      b(k, 1) = sh.Range("D" & i).Value
    End If
  Next
 
  n = ComboRecords.Value
  If n > k Then
    MsgBox "The requested number of records is greater than the number of visible rows"
    Exit Sub
  End If
 
  ReDim a(1 To n, 1 To 1)
 
  Randomize
  arr = Evaluate("ROW(1:" & k & ")")      'total visible records
  For z = 1 To n                          'how many do i want
    x = Int(Rnd * k + z)
    y = arr(z, 1)
    arr(z, 1) = arr(x, 1)
    arr(x, 1) = y
    k = k - 1
    m = arr(z, 1)                         'random number
    j = j + 1
    a(j, 1) = b(m, 1)
  Next
 
  'In array 'a' is the random data from column D
  Sheets(3).Range("A2").Resize(UBound(a)).Value = a

End Sub

In my example, the result is placed on sheet(3) starting in cell A2 and going down.

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --
 
Upvote 0
Thanks Dante - I'll give that a try and come back to you.
 
Upvote 0
Hi Dante,

That works!

So is it possible that it captures the data from columns L, B, C, E, G, I and K, in that order?

If not, can it capture those columns in their usual order?

Thanks again!
 
Upvote 0
So is it possible that it captures the data from columns L, B, C, E, G, I and K, in that order?

To get those columns, change the macro a little.

If you want to add another column, for example column "D", you add the number 4, which is the column number of column "D", on this line:
Rich (BB code):
arrN = Array(4, 12, 2, 3, 5, 7, 9, 11)

Or you can also add another column and change the order, for example, add column "P" (number 16) and change K to G:
Rich (BB code):
arrN = Array(12, 2, 3, 16, 5, 11, 9, 7)

Try:
VBA Code:
Private Sub CommandButton1_Click()
  Dim wb As Workbook
  Dim sh As Worksheet
  Dim lr&, i&, j&, k&, n&, q&, x&, y&, z&, rndrow&
  Dim a As Variant, b As Variant, c As Variant
  Dim arr As Variant, m As Variant, arrN As Variant, iNum As Variant
  
  Set wb = ThisWorkbook
  Set sh = wb.Sheets(2)
  
  lr = sh.Range("D" & Rows.Count).End(3).Row
  a = sh.Range("A1:Z" & lr).Value
  
  'gets the visible row numbers.
  ReDim b(1 To lr, 1 To 1)
  For i = 2 To lr
    If sh.Rows(i).Hidden = False Then
      k = k + 1
      b(k, 1) = i
    End If
  Next
  
  n = ComboRecords.Value
  If n > k Then
    MsgBox "The requested number of records is greater than the number of visible rows"
    Exit Sub
  End If
  
  'columns L,  B, C, E, G, I and K, in that order.
  'columns 12, 2, 3, 5, 7, 9 and 11, in that order.
  arrN = Array(12, 2, 3, 5, 7, 9, 11)
  ReDim c(1 To n, 1 To UBound(arrN) + 1)
  
  Randomize
  arr = Evaluate("ROW(1:" & k & ")")      'total visible records
  For z = 1 To n                          'how many do i want
    x = Int(Rnd * k + z)
    y = arr(z, 1)
    arr(z, 1) = arr(x, 1)
    arr(x, 1) = y
    k = k - 1
    m = arr(z, 1)                         'random number
    rndrow = b(m, 1)                      'random row
    
    j = j + 1
    q = 0
    For Each iNum In arrN
      q = q + 1
      c(j, q) = a(rndrow, iNum)
    Next
  Next
  
  'In array 'c' is the random data
  Sheets(3).Range("A2").Resize(UBound(c, 1), UBound(c, 2)).Value = c

End Sub

Regards
Dante Amor
🫡
 
Upvote 0
Solution

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top