mardi 29 mars 2016

VBA/Macro to get or copy random rows based on keywords

enter image description here

I need help to be able to get/copy random rows from another workbook with specific conditions:

source: rawdata.xlsx "Sheet1"

destination: tool.xlsm "Random Sample"

"AU", "FJ", "NC", "NZ", "SG12" are located in the first column (Column A). Attached screenshot shows how my rawdata.xlsx looks like.

If i click a button/run a macro, I should get

  • 4 random rows for all rows that has "AU"
  • 1 random row for all rows that has "FJ"
  • 1 random row for all rows that has "NC"
  • 3 random rows for all rows that has "NZ"
  • 1 random row for all rows that has "SG12"

All FROM rawdata.xlsx "Sheet1" and paste it to tool.xlsm "Random Sample".

All should happen in one click. It has been almost a month and i still got no luck being able to get answer to this question. I hope someone could help me out. Thanks.

Here is my code to get/copy random sample but without condition. I hope anyone can modify this.

Sub CopyRandomRows()

'Delete current random sample

 Sheets("Random Sample").Select
    Cells.Select
    Range("C14").Activate
    Selection.Delete Shift:=xlUp


'Remove duplicates in raw data file

Windows("rawdata.xlsx").Activate
Sheets("Sheet1").Select
Cells.RemoveDuplicates Columns:=Array(2)


'copy the header before pasting random rows

    Windows("rawdata.xlsx").Activate
    Rows("1:1").Select
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Windows("tool.xlsm").Activate
    Sheets("Random Sample").Select
    Rows("1:1").Select
    ActiveSheet.Paste


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


  ' this defines the source to take the data

  With Workbooks("rawdata.xlsx").Worksheets("Sheet1")
    Set source = .Range("A1:" & .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column).Address)
    End With

  ' this defines the target to paste the data

  Set target = Workbooks("tool.xlsm").Worksheets("Random Sample").Range("A2")

  ' this defines the number of rows to generate based on the input in textbox


  randCount = 4



  ' this load the data in an array

  data = source.value

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

  ' this writes the data to the target

  target.Resize(randCount, UBound(data, 2)) = data


End Sub




Aucun commentaire:

Enregistrer un commentaire