OK, here you go. You tell me:

Every single Random## has an exact equal and opposite. Every single time in every part of the code if points can be awarded then there is an equal counterpart. Every. Single. Time. I've been extremely careful about that.

The first ones and last ones directly reference a specific attribute.

Thus Random01 takes points from Advancement.

The last Random gives points to Advancement.

When I ran out of attributes, the rest of the subs in the middle don't do anything at all with points (mostly). If they do give points then it's a coin-flip in that sub.

And I already did what you said. I had written the whole thing willy-nilly with not regard for evenness because I didn't think I was even going to do this. Once I decided to go in the direction I'm going in now I took all of that out so that no points were given or taken anywhere.

It was then that I created the sub below and ensured it was absolutely even. Even the wait times for each counterpart sub are the same so that one can't get hit more often than another.


Code:
Private Sub Branch(Optional ByRef RandomID As Long = 0)
Dim m_CallStacker As New cCallStacker
Dim m_Hourglass As New cHourglass
Dim nRnd As Long
Static fBranching As Boolean
Static nCount As Long

' Chooses a Random Event.

m_CallStacker.Add NAME & ".Branch(Private Sub)"

If chkBeginProduction.Value = vbUnchecked Then StopAllTimers

If fBranching Or fStoryTelling Or Not Possessed Then Exit Sub

fBranching = True

m_Hourglass

Randomize Timer

nCount = nCount + 1

If (nCount = 1) Or (nCount Mod 100 = 0) Then

  AddPlayerMessage vbCrLf & "Selecting a Random Event.  Each Event has one d" & NUM_RANDOM_CHOICES & " (" & Format(100 * (1 / NUM_RANDOM_CHOICES), "#0.00") & "%) Probability of Occurring.  Random Events can Trigger More Random Events.", 2000

  nCount = 1

End If

If (RandomID > 0) And (RandomID <= NUM_RANDOM_CHOICES) Then

  nRnd = RandomID

Else

  nRnd = RollDie(NUM_RANDOM_CHOICES)

  RandomBranchCount(nRnd) = RandomBranchCount(nRnd) + 1

End If

Select Case nRnd


  Case 1

    Random01

  Case 2

    Random02

  Case 3

    Random03

  Case 4

    Random04

  Case 5

    Random05

  Case 6
  
    Random06

  Case 7

    Random07

  Case 8

    Random08

  Case 9

    Random09

  Case 10

    Random10

  Case 11

    Random11

  Case 12

    Random12

  Case 13

    Random13

  Case 14

    Random14

  Case 15

    Random15

  Case 16

    Random16

  Case 17

    Random17

  Case 18

    Random18

  Case 19

    Random19

  Case 20

    Random20

  Case 21

    Random21

  Case 22

    Random22

  Case 23

    Random23

  Case 24

    Random24

  Case 25

    Random25

  Case 26

    Random26

  Case 27

    Random27

  Case 29

    Random29

  Case 30

    Random30

  Case 31

    Random31

  Case 32

    Random32

  Case 33

    Random33

  Case 34

    Random34

  Case 35

    Random35

  Case 36

    Random36

  Case 37

    Random37

  Case 38

    Random38

  Case 39

    Random39

  Case 40

    Random40

  Case 41

    Random41

  Case 42

    Random42

  Case NUM_RANDOM_CHOICES - 1

        RandomMaxRandomChoicesMinus1

  Case NUM_RANDOM_CHOICES

    RandomMaxRandomChoices

End Select

fBranching = False

End Sub

Private Function Random01() As Long
Dim m_CallStacker As New cCallStacker
Static nTickcount As Long

m_CallStacker.Add NAME & ".Random01(Private Function)"

If EventElapsedSeconds(nTickcount) < 60 Then Exit Function

AddPlayerMessage AddAsterisks("You failed to complete a critically important task!"), 1000

mw_Player.AddAttributePoints idx_Player_Attribute_Advancements, idx_Damage

nTickcount = GetTickCount

End Function

.....

Private Sub RandomMaxRandomChoices()
Dim m_CallStacker As New cCallStacker
Static nTickcount As Long

m_CallStacker.Add NAME & ".RandomMaxRandomChoices(Private Sub)"

If EventElapsedSeconds(nTickcount) < 60 Then Exit Sub

AddPlayerMessage AddAsterisks("You successfully completed an important task!"), 1000

mw_Player.AddAttributePoints idx_Player_Attribute_Advancements, idx_Buff

nTickcount = GetTickCount

End Sub