Random Name Generator Without Ever Repeating

[superjarvo]

Hi There,

I know this has come up a billion times, but everything I have found has not solved my problem. I have a list of 50 hockey player names, a list of 10 intros, and a list of 10 ending sentences. For example: A1:A50 = player names, A60:A70 intro to a sentence ("I heard that" or "Someone told me"), and A80:A90 is the ending of a sentence ("eats monkeys for breakfast" or "is a nice person").

My goal is to have a random intro + player name + random ending. The intro and ending can be randomized and duplicated, but the player name can never be duplicated, and we must go through all 50 player names without duplicating a name once. The reason this happens is because we are auctioning off players and they are off the board when bought. I do not want to have to remove them from the list and change the formula, as I will be taking part in the draft myself. I can hit F9 to refresh, but that is all I want to do.

Can this be done? can rearrange the columns and rows if necessary.

Thanks.

 

[Special-K99]

First A60:A70 is 11 intros not 10, same with A80:A90, adjust the formula below to cater for what you really have.

Dunno about removing them from the list but this should do it.

in B1
=RAND()

in C1
=INDEX(A$61:A$70,INT(RAND()*10+61,1)&INDEX(A$1:A$50,MATCH(SMALL(B$1:B$50,ROW()),B$1:B$50,0))&INDEX(A$81:A$90,INT(RAND()*10+81,1)

Copy B1 and C1 down as far as row 50

Names will only appear once in the list

 

[Logit]

.
Here is the VBA code (below). There are formulas as well in some of the cells.

Function RandomSelection(aRng As Range)


Dim index As Integer
Randomize
index = Int(aRng.Count * Rnd + 1)
RandomSelection = aRng.Cells(index).Value
End Function


Sub rndmselect()
Dim i As Integer
Dim aRng As Range
Set aRng = Sheets("Sheet1").Range("A2:A51")
Application.ScreenUpdating = False
    Sheets("Sheet1").Range("C1").Value = Sheets("Sheet1").Range("C4").Value
    ChangeCellValue
Application.ScreenUpdating = True
End Sub


Sub ChangeCellValue()


    ' Go through each cells in the range
    Dim rg As Range
    Application.ScreenUpdating = False
    On Error Resume Next
    For Each rg In Sheet1.Range("A2:A51")


        ' Print address of cells that are negative
        If rg.Value = Sheet1.Range("C1").Value Then
           rg.Value = ""
        End If
        
        If Sheet1.Range("C1").Value = 0 Then
            MsgBox "No names remain on the list. Restart list.", vbInformation, "End of List"
            Sheet1.Range("A100:A149").Copy
            Sheet1.Range("A2").PasteSpecial xlPasteValues
            Sheet1.Range("A1").Select
            Exit Sub
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Download workbook : https://www.amazon.com/clouddrive/share/VVTJZ8FWKRkJlJmW1IMnFUiDOHpHRtohZm8soPQ09VA

 

[superjarvo]

in B1
=RAND()

in C1
=INDEX(A$61:A$70,INT(RAND()*10+61,1)&INDEX(A$1:A$50,MATCH(SMALL(B$1:B$50,ROW()),B$1:B$50,0))&INDEX(A$81:A$90,INT(RAND()*10+81,1)

Copy B1 and C1 down as far as row 50

Thanks for your response. I tried this, but I keep getting "you have entered too few arguments", and it refers to the ",1" at the end of each. After a bit of tweaking on the middle function, I go it working with just the player names, but it did repeat.

Wondering how I can just randomize the list, then have it go down the list 1 by one 1. What I mean by this is that I would hit F9 once, it would randomize the list of 50 players, then have a macro that I can click that will populate one name on a separate tab, we would bid for the player, then when done, it would just move down the list. Can this be done?

 

[Special-K99]

My mistake, it should be

in C1
=INDEX(A$61:A$70,INT(RAND()*10+1),1)&" "&INDEX(A$1:A$50,MATCH(SMALL(B$1:B$50,ROW()),B$1:B$50,0))&" "&INDEX(A$81:A$90,INT(RAND()*10+1),1)

I tested on a shortened range and it produced no repeats in the names
(This is a formula I've used many times written by someone else so it should work)

 

[superjarvo]

.
Here is the VBA code (below). There are formulas as well in some of the cells.

Function RandomSelection(aRng As Range)


Dim index As Integer
Randomize
index = Int(aRng.Count * Rnd + 1)
RandomSelection = aRng.Cells(index).Value
End Function


Sub rndmselect()
Dim i As Integer
Dim aRng As Range
Set aRng = Sheets("Sheet1").Range("A2:A51")
Application.ScreenUpdating = False
    Sheets("Sheet1").Range("C1").Value = Sheets("Sheet1").Range("C4").Value
    ChangeCellValue
Application.ScreenUpdating = True
End Sub


Sub ChangeCellValue()


    ' Go through each cells in the range
    Dim rg As Range
    Application.ScreenUpdating = False
    On Error Resume Next
    For Each rg In Sheet1.Range("A2:A51")


        ' Print address of cells that are negative
        If rg.Value = Sheet1.Range("C1").Value Then
           rg.Value = ""
        End If
        
        If Sheet1.Range("C1").Value = 0 Then
            MsgBox "No names remain on the list. Restart list.", vbInformation, "End of List"
            Sheet1.Range("A100:A149").Copy
            Sheet1.Range("A2").PasteSpecial xlPasteValues
            Sheet1.Range("A1").Select
            Exit Sub
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Download workbook : https://www.amazon.com/clouddrive/share/VVTJZ8FWKRkJlJmW1IMnFUiDOHpHRtohZm8soPQ09VA

Thank you very much for this but I have no idea how to paste a VBA code into a graphic I have put in the sheet. Works great though. Very neat.

 

[superjarvo]

My mistake, it should be

in C1
=INDEX(A$61:A$70,INT(RAND()*10+1),1)&" "&INDEX(A$1:A$50,MATCH(SMALL(B$1:B$50,ROW()),B$1:B$50,0))&" "&INDEX(A$81:A$90,INT(RAND()*10+1),1)

I tested on a shortened range and it produced no repeats in the names
(This is a formula I've used many times written by someone else so it should work)

Thanks, but it still repeats

 

[Special-K99]

Then you're doing something wrong.
I have tested this and it works fine.

"The intro and ending can be randomized and duplicated,"
Those will repeat

But the names will not.

Upload your file to an online storage site and post a link here so we can see what you've done.

 

[superjarvo]

Then you're doing something wrong.
I have tested this and it works fine.

"The intro and ending can be randomized and duplicated,"
Those will repeat

But the names will not.

Upload your file to an online storage site and post a link here so we can see what you've done.

Here is a link to the file: https://drive.google.com/file/d/1HLiHJxfB5LCcn5F5tMjfjaTlwsx8NQiH/view?usp=sharing

I have tested it a few times and wrote the numbers down to check repeating. It does, usually on the tenth try or so.

 

[Special-K99]

Again, you didnt follow my instructions.
I said copy the formula down from row 1 to row 50 in columns B and C.

You haven't done that. Column C is blank.

If you do what I said and examine the names in column C, ABSOLUTELY NONE of them repeat.

Your macro, or however you're generating that should

Loop from row 1 to row 50 retrieving each name in column C and displaying it.

The 51st display will of course be a repeat since you only have 50 names.

(I've unsubscribed from this thread as what you've asked for has been completed).