CODEWITHSUNDEEP
excelvbarandomget
markerbean
markerbean

Reputation: 145

VBA to copy specified random data from different workbook

Sub getdata()

'CTRL+J

    Windows("sample rnd.xlsm").Activate
    Range("A1:L5215").Select
    Range("A2").Activate
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Windows("rnd sample draft.xlsm").Activate
    Sheets("Random Sample").Select
    Sheets("Random Sample").Name = "Random Sample"
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Save
End Sub

Above is my code so far. It is just copying data from another another workbook and pasting it to my specified worksheet.

What I want is to get random data (rows) without duplicates and I always want to include the first row since it contains the header.

Also, I want to have a text box where I can input number so that I can specify how many data to get from the other workbook. Quite new to vba. need help.

I attached a screenshot.

layout

Upvotes: 0

Views: 1121

Answers (2)

Florent B.
Florent B.

Reputation: 42518

One solution would be to load the rows in an array, shuffle the rows and write the array to the target:

Sub CopyRandomRows()
  Dim source As Range, target As Range, randCount&, data(), value, r&, rr&, c&

  ' define the source to take the data
  Set source = Workbooks("CheckSum3.xlsm").Worksheets("Sheet17").Range("$A$1:$B$10")
  ' define the target to paste the data
  Set target = Workbooks("rnd sample draft.xlsm").Worksheets("Random Sample").Range("A1")
  ' define the number of rows to generate
  randCount = 5

  ' load the data in an array
  data = source.value

  'shuffle the rows
  For r = 1 To randCount
    rr = 1 + Math.Round(VBA.Rnd * (UBound(data) - 1))
    For c = 1 To UBound(data, 2)
      value = data(r, c)
      data(r, c) = data(rr, c)
      data(rr, c) = value
    Next
  Next

  ' write the data to the target
  target.Resize(randCount, UBound(data, 2)) = data

End Sub

Upvotes: 1

Dirk Reichel
Dirk Reichel

Reputation: 7979

a "not so smart" way to do it would be something like this:

Sub Macro1(numRows As Long)
  Dim a As Long, i As Long, rng As Range
  Windows("sample rnd.xlsm").Activate
  a = Int(Rnd() * 5213) + 2
  Set rng = Range("A1:L1")

  For i = 1 To numRows
    While Not Intersect(Cells(a, 1), rng) Is Nothing
      a = Int(Rnd() * 5213) + 2
    Wend
    Set rng = Union(rng, Range("A1:L5215").Rows(a))
  Next

  rng.Copy
  Sheets("Random Sample").Range("A1").Select
  ActiveSheet.Paste
End Sub

if you are not going for a huge amount of lines... you also could put all lines in a collection and then delete one random item in it till the count reaches the number of lines you want like this (also not so smart solution):

Sub Macro2(numRows As Long)
  Dim a As Long, myCol As New Collection, rng As Range
  Windows("sample rnd.xlsm").Activate

  For a = 2 To 5215
    myCol.Add a
  Next

  While myCol.Count > numRows
    myCol.Remove Int(Rnd() * myCol.Count) + 1
  Wend

  Set rng = Range("A1:L1")
  For a = 1 To myCol.Count
    Set rng = Union(rng, Range("A1:L5215").Rows(myCol(a)))
  Next

  rng.Copy
  Sheets("Random Sample").Range("A1").Select
  ActiveSheet.Paste
End Sub

if you still have questions, just ask ;)

Upvotes: 1

Related Questions