Random Select a Sample and Copy it into another sheet

[appu55]

Hi All,

I need a help regarding the below issue which i'm facing while automating our bill issue system.

I have an excel sheet where the tasks done by multiple users is tracked. The tasks are categorized into two types Critical and Non Critical. At the end of month a random Check is made in the total work done by each user. That report is generated from the system automatically. From this we need to pick the specified number of bills done by each user in both critical and non critical categories and paste the data in separate sheets. This is a time taking process as the number of users are more.

I got the code (from other source) that pulls the specified number of records from the total records user wise and paste it in a different sheet (i.e critical in Critical Sheet and Non Critical in Non Critical sheet). However, The sample is being picked from the top only . I just want to know if code can be edited in such a way that the sample would be picked randomly instead of picking only from TOP.

Below is the code which i'm using

Thanks in Advance

Sub ef()
Dim i&, x&, y&, user As Range, ws1 As Worksheet, ws2 As Worksheet


With Sheets("main")
For Each user In .Range("B2:B" & .Cells(Rows.Count, "B").End(xlUp).Row)
If Not .Range("L" & user.Row) = 0 Then
Set ws1 = Sheets("CRTC")
Set ws2 = Sheets("CRTC Smpl")
    
    For i = 1 To .Range("L" & user.Row)
    y = x
    On Error Resume Next
    x = x + WorksheetFunction.Match(user, ws1.Range("L" & x + 1 & ":L" & ws1.Cells(Rows.Count, "L").End(xlUp).Row), 0)
    On Error GoTo 0
    If y = x Then Exit For
    ws1.Rows(x).Copy Destination:=ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    Next i


End If


x = 0: y = 0


If Not .Range("M" & user.Row) = 0 Then
Set ws1 = Sheets("NCRTC")
Set ws2 = Sheets("NCRTC Smpl")
    
    For i = 1 To .Range("M" & user.Row)
    y = x
    On Error Resume Next
    x = x + WorksheetFunction.Match(user, ws1.Range("L" & x + 1 & ":L" & ws1.Cells(Rows.Count, "L").End(xlUp).Row), 0)
    On Error GoTo 0
    If y = x Then Exit For
    ws1.Rows(x).Copy Destination:=ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    Next i
End If


x = 0: y = 0
Next user


End With
End Sub

 

[iliace]

It would be helpful if you posted some sample data. It is difficult to interpret the existing code. For example:

* What is sheet CRTC?
* What is sheet CRTC Smpl?
* What does sheet "main" represent?
* What is in columns L and M?

and so on. If you want a basic random sample, you can use the RAND() function and sort - either using the worksheet function or VBA. If it's more complex than that, you'll have to post an example of what your data looks like.

 

[appu55]

Hi Iliace,

They are the names of sheets.

L&M contains the number of samples that needs to be picked up from the sheets.

I don't see any provision for attaching sample data. Hence couldn't post it.

 

[iliace]

They are the names of sheets.

Yes, I got that much, but purpose do they serve? Your only explanation of what the code is: "I got the code (from other source)". This is not helpful in understanding what it does. By certain characteristics - e.g. the fact that it sets ws1 and ws2 references within a loop (twice) - indicates to me that it may not be well formed code and should be re-written. What is in column B of the "main" sheet? This is just very cryptic to interpret.

I don't see any provision for attaching sample data. Hence couldn't post it.

There are plenty of add-ins available to create HTML of your worksheet sample data. I personally like this one: Download

 

[appu55]

Hi Iliace,

Thanks for providing me the option. I tried the HTML version but the output seems to be not clear.

Here's the image form of the data. Please have a look at that. Below are the Details

a. Workbook Contains 5 Sheets Main, CRTC, NCRTC, CRTC Smpl and NCRTC Smpl
b. CRTC and NCRTC sheets contain the data from which the sample needs to be picked.
c. Nothing needs to be done in the main sheet as the sheet is automatically generated from the system.