asked on

EXCEL: Random Select and Copy 10% of the Row

I have been copying random 10% of entire row of data into the new sheet. For example, i have 1000 row of the data, i have to select and copy 10% row of data (which is 100) randomly into the new sheet. Been doing this on weekly basis.

Is there way to do it automatically by selecting and copying 10% of row into the new sheet using VBA Excel?. It would be great if you can create VBA macro code to detect the entire number of row automatically and select 10% of the row randomly.

I have attached mock spreadsheet attachment and you can use the example to random select 10% of the row into new sheet

Please let me know if you have issue.
SelectRandom.xlsx

Ejgil Hedegaard

Check attached file.
Press button to run.

This is the code

Option Explicit

Sub Extract10Percent()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rwMax As Long, rw As Long
    
    Application.ScreenUpdating = False
    
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets.Add
    ws1.Range("A2").CurrentRegion.Copy ws2.Range("A1")
    rwMax = ws2.Range("A1").CurrentRegion.Rows.Count
    ws2.Range("D1") = "Random"
    For rw = 2 To rwMax
        ws2.Range("D" & rw) = WorksheetFunction.RandBetween(1, 10)
    Next rw
    ws2.Range("A1").CurrentRegion.Sort Key1:="Random", Order1:=xlAscending, Header:=xlYes
    rw = WorksheetFunction.RoundUp((rwMax - 1) / 10, 0) + 2
    ws2.Range("D1:D" & rwMax).ClearContents
    ws2.Range("A" & rw & ":C" & rwMax).ClearContents
    ws2.Range("A1").CurrentRegion.Sort Key1:="No", Order1:=xlAscending, Header:=xlYes
End Sub

Open in new window

SelectRandom.xlsm

Sherry

ASKER

Ejgil Hedegaard

Many thanks for the prompt solution, it has met my expectation entirely and very interesting coding. I have one more query.

If i have 30 column of data, is there way that your code that identify the last column instead of putting column "D" in your coding.

Just incase if i have come across with different number of column

Many thanks

Sherry

ASKER

Apologies another query, I have changed the number to 5 in the coding and it doesn't generate 5% number of alert.

ASKER CERTIFIED SOLUTION

Ejgil Hedegaard

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Sherry

ASKER

Thanks Ejigil

That was smart coding but received coding error when i run them. see attached

Good idea on the custom percentage
Screen-Shot-2016-10-27-at-19.29.25.png
Screen-Shot-2016-10-27-at-19.32.57.png

Ejgil Hedegaard

Guess you used the code in another workbook, where the named range ExtractPercentage is missing.
Name the cell with the percentage value, and it will work.
The name must be ExtractPercentage, or if you use something else, change the name in the brackets [ ] to whatever you name it.

Sherry

ASKER

Excellent Answer and Interesting VBA coding. Expectation met