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