CODEWITHSUNDEEP
vbarandommacrosconditional-statements
markerbean
markerbean

Reputation: 145

VBA/Macro to get random data with multiple conditions

I need help to be able to get random data from another worksheet with specific conditions

Something like this:

If i click a button or run a macro, I should get 4 random samples for all rows that has AA, 1 random sample for all rows that has BB, 1 random sample for all rows that has CC, 3 random samples for all rows that has DD, and 1 random sample for all rows that has EE FROM rawdata.xlsx "Sheet1" sheet and paste it to tool.xlsm "Random Sample" sheet.

All should happen in one click.

This is my code so far. I can only get specific amount of random data within the whole worksheet. I hope someone can edit this code for me or give the code to help me out and be able to make what i want to do. thanks in advance

Sub CopyRandomRows()


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


 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
  Set source = Workbooks("rawdata.xlsx").Worksheets("Sheet1").Range("A2:L5215")

  '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 = 20
  'this loads the data in an array
  data = source.value

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

Upvotes: 0

Views: 2229

Answers (1)

Maciej Los
Maciej Los

Reputation: 8591

I would do that this way:

Option Explicit

'******************************************************
'*** needs reference to Microsoft Scripting Runtime ***
'******************************************************
Sub GetRandomSamples()
Dim oDicSam As Dictionary
Dim iCounter As Integer, k As Variant, iRandom As Integer, iRndMin As Integer, iRndMax As Integer, j As Integer
Dim source As Worksheet, target As Worksheet

On Error GoTo Err_GetRandomSamples

Set source = ThisWorkbook.Worksheets(1)
Set target = ThisWorkbook.Worksheets(2)

'define the range for randomizing
iRndMin = 1
iRndMax = 500

'define the numbers of records for each column    
Set oDicSam = New Dictionary
oDicSam.Add "AA", 4
oDicSam.Add "BB", 1
oDicSam.Add "CC", 1
oDicSam.Add "DD", 3
oDicSam.Add "EE", 1

j = 1
Randomize
For Each k In oDicSam.Keys
    For iCounter = 1 To oDicSam.Item(k)
        iRandom = Int((iRndMax - iRndMin + 1) * Rnd + iRndMin)
        'MsgBox "Random number for '" & k & "' is: " & iRandom, vbInformation, "Randomizing - " & iCounter
        source.Range(k & iRandom).Copy target.Range("A" & j)
        j = j + 1
    Next
Next

Exit_GetRandomSamples:
    On Error Resume Next
    Set source = Nothing
    Set target = Nothing
    Set oDicSam = Nothing
    Exit Sub


Err_GetRandomSamples:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_GetRandomSamples

End Sub

As you can see, i'm using Dictionary object, which is helpful in defining the number of samples to get for each column. Then, i'm using thw loops. First one is going through the collection of keys, and the second one uses value (item) related to this key.

Feel free to change the code to your needs.

Upvotes: 1

Related Questions