Generating a random word from a list that is dependant on previous selections

[DariaLoveborn]

Hello,

This is the first time I've ever posted on a forum but I've scoured the internet for a solution to no avail.

I am creating a character generator and require it to randomly select a skill from a list that is dependant on the character level and also previous skills selected.

(Ignore the data in column O for now, it was a test) I want it to randomly select 2 skills from the LVL1 section of column M. Then, In column P I want it to randomly select 2 skills from the LVL1 and LVL2 sections of M without returning any of the selections from previous results.

I'm semi familiar with VBA and with clear instruction I can pretty much put anything together. I just can't figure this out.

Please help.

Thanks

Jen

 

[Snakehips]

@DariaLoveborn If I understand correctly then, maybe something like the below
Assumes that your data in image is effectively starting at row 2.

Sub GetSkills()
Dim Arry() As Variant
Dim N As Long
Dim Temp As Variant
Dim J As Long


Range("P2:P5").ClearContents
   Arry = Range("M2:M5").Value
    Randomize
    For N = LBound(Arry, 1) To UBound(Arry, 1)
        J = CLng(((UBound(Arry, 1) - N) * Rnd) + N)
        If N <> J Then
            Temp = Arry(N, 1)
            Arry(N, 1) = Arry(J, 1)
            Arry(J, 1) = Temp
        End If
    Next N
  
    Cells(2, "P") = Arry(1, 1)
    Cells(3, "P") = Arry(2, 1)

    Arry = Range("M2:M13")
      Randomize
    For N = LBound(Arry, 1) To UBound(Arry, 1)
        J = CLng(((UBound(Arry, 1) - N) * Rnd) + N)
        If N <> J Then
            Temp = Arry(N, 1)
            Arry(N, 1) = Arry(J, 1)
            Arry(J, 1) = Temp
        End If
    Next N
  
    L = 4
    For N = LBound(Arry, 1) To UBound(Arry, 1)
        If Arry(N, 1) <> Cells(2, "P") And Arry(N, 1) <> Cells(3, "P") And Arry(N, 1) <> Cells(4, "P") Then
        Cells(L, "P") = Arry(N, 1)
        L = L + 1
      
        End If
        If L = 6 Then Exit For
    Next N
      
End Sub

Hope that helps.

 

[DariaLoveborn]

Hiya,

Am I putting the code in as a macro?

Thanks

Jen

 

[Snakehips]

Yes. It's not in itself specifying a particular sheet so right click the sheet in question > view code, then paste it into the code pane for that sheet and run it with that sheet selected.

 

[DariaLoveborn]

Thank you, if I wanted it t do the same thing up to skill 15 could I just copy and paste and then amend the earlier parts of the code?

 

[Snakehips]

Maybe not quite that simple. I would need to consider properly.
Are you always wanting to go through all the 15 levels. Or is it a progressive thing?
Is it always going to be two more skills per level, including the new skills and any unused from prior levels?

 

[DariaLoveborn]

Hiya yes it is. Always 2 extra skills per level including previous unused.

The code works currently just needs extending.

By the way you are a lifesaver!!! This has been frustrating me for about 6 hours now.

 

[Snakehips]

I will probably not be able to look at this now until tomorrow. What is the reasoning for progressing downwards rather than randomising the whole list?
Is it so that the list you create relates to levels, two skills/ rows at a time?

 

[DariaLoveborn]

That's exactly it. Ordinarily a character will pick 2 skills at each level. They can add skills from a lover level to a higher level spot but not the other way around. I really appreciate the help with this. I love learning new things so this is brilliant. Tomorrow is perfectly fine. Thank you so much for the help.

Jen

 

[Snakehips]

Jen, I have been playing with this and despite a bit of frustration here and there, I think this might be it.

Book1
	L	M	N	O	P
1
2	Lvl1	Field Dressing			Long One Handed
3		Mana Band			Mana Band
4		Long One Handed			Cleave
5		Bastard			Bastard
6	Lvl2	Field Dressing			Healing Song
7		Mana Band			Basic Ground Trap
8		Long One Handed			Field Dressing
9		Bastard			Padded Armour
10		Mana Band			Dart/Shot Specialisation
11		Mana Band			Buckler Shield
12		Cleave			Short Polearm
13		Basic Ground Trap			Way Lay
14	Lvl3	Healing Song			Poison Weapon
15		Padded Armour			Light Armour
16	Lvl4	Poison Weapon			Words Of Clarity
17		Thrown Weapons			Flight Weapons
18		Dart/Shot Specialisation			Thrown Weapons
19	Lvl5	Light Armour			Hideous Laughter
20		Mana Band			Medium Sheild
21		Words Of Clarity			Medium Armour
22		Buckler Shield			Bardic Inspiration
23	Lvl6	Way Lay			Band Of Brothers
24		Short Polearm			Magical Law
25		Mana Band			Shank
26	Lvl7	Hideous Laughter
27		Mana Band
28	Lvl8	Flight Weapons
29		Mana Band
30	Lvl9	Mana Band
31	Lvl10	Medium Armour
32		Medium Sheild
33	Lvl12	Band Of Brothers
34		Bardic Inspiration
35	Lvl15	Shank
36		Magical Law
37	Lvl18	Taunt
Sheet7

Sub GetSkills2()
Dim SklArry(2 To 36) As Variant
Dim PicArry() As Variant
Dim SklRes As Range

Dim N As Long
Dim Temp As Variant
Dim J As Long
Dim r, c, B, LastRow As Integer
    
Set SklPics = Range("P2:P25") 'Result Range of random picks
SklPics.ClearContents
'put All skills Level 1 thro' 15  to array
For r = 2 To 36
    SklArry(r) = Cells(r, "M")
Next r

'Make successive picks of two from each level and balance of previous unpicked skills
'level 1 thro 15 is 12 sections
For c = 1 To 12
    'Get last row of latest level
    LastRow = Application.WorksheetFunction.Choose(c, 5, 13, 15, 18, 22, 25, 27, 29, 30, 32, 34, 36)
    'put 'available' skills into pick array
    'NB Previously picked skills will be cleared, set to ""
    ReDim PicArry(1 To 35)
    B = 0
    For r = 2 To LastRow
        If Not SklArry(r) = "" Then
            B = B + 1
            PicArry(B) = SklArry(r)
        End If
    Next r
    ReDim Preserve PicArry(1 To B)
    
    'Random shuffle the current set of available skills
    
    Randomize
        For N = LBound(PicArry) To UBound(PicArry)
            J = CLng(((UBound(PicArry) - N) * Rnd) + N)
            If N <> J Then
                Temp = PicArry(N)
                PicArry(N) = PicArry(J)
                PicArry(J) = Temp
            End If
        Next N
            
    'Put picks 1 and 2 to the result list
    Cells(c * 2, "P") = PicArry(1)
    'Ensure pick 2 is not a duplicate of pick 1
    x = 2
    Do While PicArry(x) = PicArry(1)
        x = x + 1
    Loop
    
    Cells(c * 2 + 1, "P") = PicArry(x)
    
    'remove the picked skills from the Skills array
    For r = 2 To 36
        If SklArry(r) = PicArry(1) Or SklArry(r) = PicArry(x) Then SklArry(r) = ""
    Next r
Next c
    
End Sub

Hope that helps.