title: copy random row if condition meets
body: <p>I have two columns one is user name and other one is decision now for each unique user i want 10% data.. for example if user name is Rohit and decision yes than 10% random of all rows where user decision was yes again for no 10% all the row of same user where decision is NO, This code is giving 10% data of unique name from column user only.</p>
  
  <pre><code>Sub Random10_EveryName()
      Randomize 'Initialize Random number seed
  
       Application.ScreenUpdating = False
  
      'Copy Sheet1 to new sheet
       Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)
  
      'Clear old data in Sheet 2
       Sheets(2).Cells.ClearContents
  
      'Determine Number of Rows in Sheet1 Column A
       numRows = Sheets(Sheets.Count).Cells(Rows.Count, _
       "A").End(xlUp).Row
  
      'Sort new sheet by Column E
       Sheets(Sheets.Count).Cells.Sort _
       key1:=Sheets(Sheets.Count).Range("O1:D" &amp; numRows), _
       order1:=xlAscending, Header:=xlYes
  
      'Initialize numNames &amp; startRow variable
       numNames = 1
       startRow = 2
  
      'Loop through sorted names, count number of current Name
       For nameRows = startRow To numRows
       If Sheets(Sheets.Count).Cells(nameRows, "D") = _
       Sheets(Sheets.Count).Cells(nameRows + 1, "D") Then
       numNames = numNames + 1
       Else:
       endRow = startRow + numNames - 1
  
      'Generate Random row number within current Name Group
       nxtRnd = Int((endRow - startRow + 1) * _
       Rnd + startRow)
  
      'Copy row to Sheet2, Delete copied Name
       dstRow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
       Sheets(Sheets.Count).Rows(nxtRnd).EntireRow.Copy _
       Destination:=Sheets(2).Cells(dstRow, 1)
       Sheets(Sheets.Count).Cells(nxtRnd, "D").ClearContents
  
      'Set Start Row for next Name Group, reset numNames variable
       startRow = endRow + 1
       numNames = 1
       End If
       Next
  
      'Sort new sheet by Column O
       Sheets(Sheets.Count).Cells.Sort _
       key1:=Sheets(Sheets.Count).Range("O1:E" &amp; numRows), _
       order1:=xlAscending, Header:=xlYes
  
      'Determine Number of Remaining Names in new sheet Column O
       numNamesleft = Sheets(Sheets.Count).Cells(Rows.Count, _
       "E").End(xlUp).Row - 1
  
      'Determine 10% of total entries from Sheet1
       percRows = _
       WorksheetFunction.RoundUp((numRows - 1) * 0.2, 0)
  
      'Determine how many extra rows are needed to reach 10% of total
       unqNames = Sheets(2).Cells(Rows.Count, _
       "E").End(xlUp).Row - 1
       extRows = percRows - unqNames
  
      'Warn user if number of Unique Names exceeds 10% of Total Entires
       If extRows &lt; 0 Then
       MsgBox "Number of Unique Names Exceeds 10% of Total Entries"
      'Delete new sheet
       Application.DisplayAlerts = False
       Sheets(Sheets.Count).Delete
       Application.DisplayAlerts = True
       Exit Sub
       End If
  
      'Extract Random entries from remaining names to reach 10%
      '
      'Allocate elements in Array
       ReDim MyRows(extRows)
      'Create Random numbers and fill array
       For nxtRow = 1 To extRows
      getNewRnd:
      'Generate Random row numbers within current Name Group
       nxtRnd = Int((numNamesleft - 2 + 1) * _
       Rnd + 2)
      'Loop through array, checking for Duplicates
       For chkRnd = 1 To nxtRow
      'Get new number if Duplicate is found
       If MyRows(chkRnd) = nxtRnd Then GoTo getNewRnd
       Next
      'Add element if Random number is unique
       MyRows(nxtRow) = nxtRnd
       Next
  
      'Loop through Array, copying rows to Sheet2
       For copyrow = 1 To extRows
       dstRow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
       Sheets(Sheets.Count).Rows(MyRows(copyrow)).EntireRow.Copy _
       Destination:=Sheets(2).Cells(dstRow, 1)
       Next
  
      'Delete new sheet
       Application.DisplayAlerts = False
       Sheets(Sheets.Count).Delete
       Application.DisplayAlerts = True
  
      End Sub
  </code></pre>