Solved Pick a Random Job per ID and paste it into another sheet

September 6, 2016 at 08:57:00
Specs: Windows 7
VBA Macro Request - We need to Pick a random Job (complete row) for one ID (under columnB) and then copy the whole row and paste it into the Random Tab, each time we run the report it should be a different Job

See More: Pick a Random Job per ID and paste it into another sheet

Report •

✔ Best Answer
September 9, 2016 at 21:00:39
I suggest that you test this code in a backup copy of your workbook in case things go terribly wrong.

The following code assumes:

- Your list of ID's are in Sheet1!Column B
- You have a header in Column B with your actual data (ID's) starting in Row 2

1 - The code copies Sheet1 and adds it to the end of the workbook.
2 - It then deletes the current list in the Random sheet.
3 - It then sorts the new sheet by ID (Column B).
4 - It then determines which rows contain the first and last entry of the first ID.
5 - Once it knows the starting and ending rows, the code generates a random number within that range and copies the row to Random.
6 - Steps 4-5 are repeated until one occurrence of each id has been copied to Random.
7 - Finally, the code deletes the new Sheet.

Let me know how it works for you.

Sub EachRandomID()
'Initialize Random number seed
  Randomize
  Application.ScreenUpdating = False

'Copy Sheet1 to new sheet
   Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)

'Clear old data in Random Sheet
  Sheets(2).Cells.ClearContents
  
'Determine Number of Rows in Sheet1 Column B
  numRows = Sheets(Sheets.Count).Cells(Rows.Count, _
              "B").End(xlUp).Row
              
'Sort new sheet by Column B
  Sheets(Sheets.Count).Cells.Sort _
   key1:=Sheets(Sheets.Count).Range("B1:B" & numRows), _
   order1:=xlAscending, Header:=xlYes

'Initialize numIDs & startRow variable
  numIDs = 1
  startRow = 2

'Loop through sorted IDs, count number of current ID
    For idRows = startRow To numRows
      If Sheets(Sheets.Count).Cells(idRows, "B") = _
         Sheets(Sheets.Count).Cells(idRows + 1, "B") Then
           numIDs = numIDs + 1
      Else:
        endRow = startRow + numIDs - 1

'Generate Random row number within current ID Group
           nxtRnd = Int((endRow - startRow + 1) * _
                         Rnd + startRow)

'Copy row to Random Sheet
         dstRow = Sheets("Random").Cells(Rows.Count, "B").End(xlUp).Row + 1
           Sheets(Sheets.Count).Rows(nxtRnd).EntireRow.Copy _
             Destination:=Sheets("Random").Cells(dstRow, 1)
        
'Set Start Row for next ID Group, reset numIDs variable
        startRow = endRow + 1
        numIDs = 1
      End If
    Next

'Delete new sheet
    Application.DisplayAlerts = False
       Sheets(Sheets.Count).Delete
    Application.DisplayAlerts = True
       Sheets("Random").Activate
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.



#1
September 7, 2016 at 06:32:12
Without knowing how your data is laid out, it's a little difficult to offer a solution at this point.

It is not clear to me if there are more than one ID in Column B or multiple occurrences of each.

If there are multiple occurrences, are they sorted/grouped by ID or just randomly spread out in Column B?

You said "Pick a random Job...for one ID"

Do you mean a pick a random job for each ID - again, assuming there are multiple ID's - or do you really mean "pick a random job for just one ID?

re: Each time we run the report it should be a different Job

It is not clear to me if you want the previous reports cleared or if you are adding new random jobs to the list each time the report is run. In either case, the output from every report will have to be saved someplace and checked every time the report is run. VBA can't "remember" which rows it chose last time (or the time before that, etc.) so it would have to check the previous output(s) in order to determine if a specific job has been extracted before. The checking of the previous data will get slower and slower as the list of previous outputs grows. This may or may not be noticeable to the user, depending on the size of the data. For example, if there are 10 previous jobs already extracted, the time it takes to check the previous output won't even be noticeable. However, if there are 1000 previous outputs, the code will have to pick a random job, check it against the previous list, use it if "new" or go back and randomly pick another job, check it against the previous list, etc. The job picked might work the first time ot it might take multiple iterations to find a "new" job.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
September 7, 2016 at 07:07:39
Hello DerbyDad

Below are my comments which will get you an idea as I am not able to attach any sheet in this forum.

It is not clear to me if there are more than one ID in Column B or multiple occurrences of each. - Yes, It is more than one ID with multiple occurrences of each ID in Column B

If there are multiple occurrences, are they sorted/grouped by ID or just randomly spread out in Column B? No, the IDs are randomly spread out in Column B

You said "Pick a random Job...for one ID" Yes

Do you mean a pick a random job for each ID - again, assuming there are multiple ID's - or do you really mean "pick a random job for just one ID? Yes, again we need to pick a random job per ID


Report •

#3
September 7, 2016 at 07:15:08
You did not answer my last question.

Is the output an ever expanding list or a brand new list each time? If it is a brand new list each time, where do you plan to store the previous output(s) to ensure that a "different" job is chosen each time?

In addition, what do you expect to happen once every job had been extracted for a given ID? e.g 10 jobs for ID "A", 10 reports run, all jobs randomly extracted. What do you expected to happen when the report is run for the 11th time?

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Related Solutions

#4
September 7, 2016 at 07:32:23
Apologise for missing out the last one :)

Is the output an ever expanding list or a brand new list each time? If it is a brand new list each time, where do you plan to store the previous output(s) to ensure that a "different" job is chosen each time?

It should be brand new list each time.

In addition, what do you expect to happen once every job had been extracted for a given ID? e.g 10 jobs for ID "A", 10 reports run, all jobs randomly extracted. What do you expected to happen when the report is run for the 11th time?

It should be random pick each time; same job can be picked, but there should not be a pattern for it (For e.g. Every first job of a user or last job for a user).

message edited by Jai6561


Report •

#5
September 7, 2016 at 07:51:30
re: "It should be random pick each time; same job can be picked, but there should not be a pattern for it "

A "random pick" is exactly that - random. One would not expect that there would be a pattern, but just like flipping a coin, the flip could randomly produce "Tails" 100% of the time or every 3rd flip or 2 Tails, 3 Heads, 2 Tails, 3 Heads, forever. Each individual flip is random in it's result, but that does not exclude the possibility of a pattern being formed.

I'll work on something but please be patient. This a complicated request and all coding is done when free time allows.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#6
September 7, 2016 at 07:55:10
Thanks a lot Derby... I can wait :) for sure...

Report •

#7
September 9, 2016 at 21:00:39
✔ Best Answer
I suggest that you test this code in a backup copy of your workbook in case things go terribly wrong.

The following code assumes:

- Your list of ID's are in Sheet1!Column B
- You have a header in Column B with your actual data (ID's) starting in Row 2

1 - The code copies Sheet1 and adds it to the end of the workbook.
2 - It then deletes the current list in the Random sheet.
3 - It then sorts the new sheet by ID (Column B).
4 - It then determines which rows contain the first and last entry of the first ID.
5 - Once it knows the starting and ending rows, the code generates a random number within that range and copies the row to Random.
6 - Steps 4-5 are repeated until one occurrence of each id has been copied to Random.
7 - Finally, the code deletes the new Sheet.

Let me know how it works for you.

Sub EachRandomID()
'Initialize Random number seed
  Randomize
  Application.ScreenUpdating = False

'Copy Sheet1 to new sheet
   Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)

'Clear old data in Random Sheet
  Sheets(2).Cells.ClearContents
  
'Determine Number of Rows in Sheet1 Column B
  numRows = Sheets(Sheets.Count).Cells(Rows.Count, _
              "B").End(xlUp).Row
              
'Sort new sheet by Column B
  Sheets(Sheets.Count).Cells.Sort _
   key1:=Sheets(Sheets.Count).Range("B1:B" & numRows), _
   order1:=xlAscending, Header:=xlYes

'Initialize numIDs & startRow variable
  numIDs = 1
  startRow = 2

'Loop through sorted IDs, count number of current ID
    For idRows = startRow To numRows
      If Sheets(Sheets.Count).Cells(idRows, "B") = _
         Sheets(Sheets.Count).Cells(idRows + 1, "B") Then
           numIDs = numIDs + 1
      Else:
        endRow = startRow + numIDs - 1

'Generate Random row number within current ID Group
           nxtRnd = Int((endRow - startRow + 1) * _
                         Rnd + startRow)

'Copy row to Random Sheet
         dstRow = Sheets("Random").Cells(Rows.Count, "B").End(xlUp).Row + 1
           Sheets(Sheets.Count).Rows(nxtRnd).EntireRow.Copy _
             Destination:=Sheets("Random").Cells(dstRow, 1)
        
'Set Start Row for next ID Group, reset numIDs variable
        startRow = endRow + 1
        numIDs = 1
      End If
    Next

'Delete new sheet
    Application.DisplayAlerts = False
       Sheets(Sheets.Count).Delete
    Application.DisplayAlerts = True
       Sheets("Random").Activate
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#8
September 14, 2016 at 01:57:15
Hello DerbyDad03

Sorry for the delay in response. I have applied your code into the data but it throws a run-time error 9: "Subscript out of Range" and by looking at the sheet, new sheet created with sorting out of IDs. Can you please help in that regard.


Report •

#9
September 14, 2016 at 04:04:30
Do you have a Sheet named Random in your workbook?

Is the name exactly Random, same case, no spaces, just Random?

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#10
September 14, 2016 at 04:36:56
Hello Derby... Its working finally with your code... Thanks a lot for your help. I forgot to put the sheet name as Random. Now its working fine.

Report •

#11
September 14, 2016 at 05:40:47
I'm glad you got it working. I do see a possible issue that I think we should clear up.

When I built my test workbook, I set the Random sheet as the second sheet in the workbook. I then wrote the code with a reference to Sheets(2). When I was cleaning up the code I forgot to change that reference to Sheets("Random"). The code will work as long as the Random sheet is the second sheet, which I have to assume it is for you also.

This line should be changed as follows so that the Random sheet can be placed anywhere in the workbook:

From:

'Clear old data in Random Sheet
  Sheets(2).Cells.ClearContents

To:

'Clear old data in Random Sheet
  Sheets("Random").Cells.ClearContents

Without that change, the code is going to clear the contents of the second sheet in the workbook regardless of its name.

Sorry about that!

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#12
September 15, 2016 at 00:59:40
Thank you DerbyDad.. One final query, is there a way to throw the random job# starting from Row 2, so that we can put headings in Row 1..if so, let us know on how to tweak the code to throw the results from Row 2 under Random sheet.

Report •

#13
September 15, 2016 at 06:11:08
When I run the code, it already starts placing data in Row 2. Row 1 is blank.

If you want to use the same column headers as in Sheet1 in the Random sheet, then change this...

'Clear old data in Random Sheet
  Sheets("Random").Cells.ClearContents

...to this:

'Clear old data in Random Sheet, copy Sheet1 column headers
  Sheets("Random").Cells.ClearContents
  Sheets(1).Rows(1).Copy Sheets("Random").Range("A1")

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#14
September 15, 2016 at 06:24:08
Thanks derby... Got it..

Report •

Ask Question