Copy x number of random rows from filtered range

[sharky12345]

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

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?

 

[DanteAmor]

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".​

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
----- --

 

[sharky12345]

Thanks Dante - I'll give that a try and come back to you.

 

[sharky12345]

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!

 

[DanteAmor]

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:

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:

arrN = Array(12, 2, 3, 16, 5, 11, 9, 7)

Try:

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