# Which random number generator does Excel VBA use?

The only piece of information I could obtain about the current (i.e., Excel 365) random number generator used by Excel VBA is Visual Basic for Applications/A PRNG for VBA (a wikibook), which states "Microsoft's Visual Basic for Applications (VBA), at present uses a linear congruential generator (LCG) for pseudo-random number generation in the Rnd() function" and at the bottom "This page was last edited on 16 April 2020, at 06:55." This alone would answer you question.

But since it is not necessarily an authoritative source, you would have to check this. Is Excel VBA's Rnd() really this bad? shows an example for how to do this.

As an alternative, this shows the basic algorithm for Excel's Rnd:

x1 = ( x0 * a + c ) MOD m
Rnd() = x1/m


where:

Rnd() = returned value
m = modulus = (2^24)
x1 = new value
x0 = previous value (initial value 327680)
a = 1140671485
c = 12820163
Repeat length = m = (2^24) = 16,777,216


You may implement it and compare the results it produces with the results from Rnd, and check if it is faithful.

Note: You are right in that this changed across versions. See, e.g., How good is the RAND() function in Excel for Monte Carlo simulation? In particular, the update between 2007 (On the accuracy of statistical procedures in Microsoft Excel 2007) and 2010 (On the accuracy of statistical procedures in Microsoft Excel 2010). Perhaps there's a niche for yet another paper, as of now.

As for alternative generators, in case you don't like what is built-in, there are quite a few out there. A brief list (some are posted in comments) is given here, code is posted below for clarity:

1. Mersenne Twister in BASIC

2. VBA Code - Wichmann-Hill (1982)

4. Mersenne Twister Random Number Generator Algorithm

1. Carmine Arturo Sangiovanni's implementation of Mersenne-Twister
' Visual Basic Mersenne-Twister
' Author: Carmine Arturo Sangiovanni
'         carmine @ daygo.com.br
'     daygo_gaming @ hotmail.com
'
'         Aug 13,2004
'
'         based on C++ code
'
'
'   Jan 4, 2010
'   rev1
'   bug fixes sent by Takano Akio (aljee @ hiper.cx)
'   look for 'rev1:' to see changes

Option Explicit

Const N = 624
Const M = 397

Global mt(0 To N) As Currency
Global mti As Currency

Dim MATRIX_A As Currency

Function tempering_shift_u(ty As Currency)
tempering_shift_u = f_and(Int(ty / 2048@), FULL_MASK)
End Function

Function tempering_shift_s(ty As Currency)
tempering_shift_s = and_ffffffff(ty * 128@)
End Function

Function tempering_shift_t(ty As Currency)
tempering_shift_t = and_ffffffff(ty * 32768@)
End Function

Function tempering_shift_l(ty As Currency)
tempering_shift_l = f_and(Int(ty / 262144@), FULL_MASK)
End Function

Function f_and(p1 As Currency, p2 As Currency)
Dim v As Currency
Dim i As Integer

f_and = p1 And p2
End If

f_and = p1 And (p2 - UPPER_MASK)
End If

f_and = (p1 - UPPER_MASK) And p2
End If

End If
End Function

Function f_or(p1 As Currency, p2 As Currency)
Dim v As Currency
Dim i As Integer
Dim f As Boolean

f_or = p1 Or p2
End If
f_or = p1 Or (p2 - UPPER_MASK)
End If
f_or = (p1 - UPPER_MASK) Or p2          'rev1: replaced 'And' with 'Or'
End If
f_or = (p1 - UPPER_MASK) Or (p2 - UPPER_MASK)   'rev1: replaced 'And' with 'Or'
End If
End Function

Function f_xor(p1 As Currency, p2 As Currency)
Dim v As Currency
Dim i As Integer
Dim f1 As Boolean, f2 As Boolean

f_xor = p1 Xor p2
End If
f_xor = p1 Xor (p2 - UPPER_MASK)
End If
f_xor = (p1 - UPPER_MASK) Xor p2
End If
End If
End Function

Function f_lower(ByVal p1 As Currency)          'rev1: added ByBal
Do
f_lower = p1
Exit Do
Else
End If
Loop
End Function

Function f_upper(ByVal p1 As Currency)          'rev1: added ByVal
Else
f_upper = 0
End If
End Function

Function f_xor3(p1 As Currency, p2 As Currency, p3 As Currency)
Dim v As Currency
Dim tmp As Currency
Dim i As Integer
Dim f As Integer

tmp = p1 Xor p2
End If
tmp = p1 Xor (p2 - UPPER_MASK)
End If
tmp = (p1 - UPPER_MASK) Xor p2
End If
End If

f_xor3 = tmp Xor p3
End If
f_xor3 = tmp Xor (p3 - UPPER_MASK)
End If
f_xor3 = (tmp - UPPER_MASK) Xor p3
End If
End If
End Function

Function and_ffffffff(ByVal c As Currency)      'rev1: added ByVal
Dim e As Currency
Dim i As Integer

i = 32
Do
e = 2 ^ (i + 16)
Do While c >= e
c = c - e
Loop
i = i - 1
Loop While i > 15
and_ffffffff = c
End Function

Sub random_init(seed As Currency)
mt(0) = and_ffffffff(seed)
For mti = 1 To N - 1
mt(mti) = and_ffffffff(69069 * mt(mti - 1))
Next mti
End Sub

Function Mersenne_twister_random(max As Integer)

Dim kk As Integer

Dim ty1 As Currency
Dim ty2 As Currency
Dim y As Currency

Dim mag01(0 To 1) As Currency

MATRIX_A = 2567483615@              '&H9908b0df

mag01(0) = 0@
mag01(1) = MATRIX_A

If mti >= N Then
If mti = N + 1 Then
random_init 4537
End If

For kk = 0 To (N - M) - 1
y = f_or(f_upper(mt(kk)), f_lower(mt(kk + 1)))
mt(kk) = f_xor3(mt(kk + M), Int(y / 2@), mag01(f_and(y, 1)))
Next kk

For kk = kk To (N - 1) - 1
y = f_or(f_upper(mt(kk)), f_lower(mt(kk + 1)))
mt(kk) = f_xor3(mt(kk + (M - N)), Int(y / 2@), mag01(f_and(y, 1)))
Next kk

y = f_or(f_upper(mt(N - 1)), f_lower(mt(0)))
mt(N - 1) = f_xor3(mt(M - 1), Int(y / 2@), mag01(f_and(y, 1)))
mti = 0
End If

'---------------------------------------------------
y = mt(mti): mti = mti + 1

'---------------------------------------------------
y = f_xor(y, tempering_shift_u(y))

y = f_xor(y, ty1)

y = f_xor(y, ty1)

y = f_xor(y, tempering_shift_l(y))

'---------------------------------------------------
If max = 0 Then
Mersenne_twister_random = 0
Else
Mersenne_twister_random = Int(y / 32) Mod max
End If
End Function

1. Code here should be saved as a separate standard module in Excel.
Option Explicit
Dim nSamples As Long
Dim nX As Long, nY As Long, nZ As Long

Sub TestRndX()
'run this to obtain RndX() samples
'Wichmann, Brian; Hill, David (1982), Algorithm AS183:
'An Efficient and Portable Pseudo-Random Number Generator,
'Journal of the Royal Statistical Society. Series C
Dim n As Long

'reset module variables
nX = 0: nY = 0: nZ = 0

RandomizeX
For n = 1 To 10
Debug.Print RndX()
MsgBox RndX()
Next n

'reset module variables
nX = 0: nY = 0: nZ = 0

End Sub

Sub TestScatterChartOfPRNG()
'run this to make a point scatter chart
'using samples from RndX

Dim vA As Variant, n As Long
Dim nS As Long, nR As Double

'remove any other charts
'DeleteAllCharts

'reset module variables
nX = 0: nY = 0: nZ = 0

'set number of samples here
nSamples = 1000
ReDim vA(1 To 2, 1 To nSamples) 'dimension array

RandomizeX
For n = 1 To nSamples
nR = RndX()
vA(1, n) = n  'x axis data - sample numbers
vA(2, n) = nR 'y axis data - prng values
Next n

'make scatter point chart from array
ChartScatterPoints vA, 1, 2, nSamples & " Samples of RndX()", _
"Sample Numbers", "PRNG Values [0,1]"

'reset module work variables
nX = 0: nY = 0: nZ = 0

End Sub

Sub RandomizeX(Optional ByVal nSeed As Variant)
'sets variables for PRNG procedure RndX()

Const MaxLong As Double = 2 ^ 31 - 1
Dim nS As Long
Dim nN As Double

'make multiplier
If IsMissing(nSeed) Then
nS = Timer * 60
Else
nN = Abs(Int(Val(nSeed)))
If nN > MaxLong Then 'no overflow
nN = nN - Int(nN / MaxLong) * MaxLong
End If
nS = nN
End If

'update variables
nX = (nS Mod 30269)
nY = (nS Mod 30307)
nZ = (nS Mod 30323)

'avoid zero state
If nX = 0 Then nX = 171
If nY = 0 Then nY = 172
If nZ = 0 Then nZ = 170

End Sub

Function RndX(Optional ByVal nSeed As Long = 1) As Double
'PRNG - gets pseudo random number - use with RandomizeX
'Wichmann-Hill algorithm of 1982

Dim nResult As Double

'initialize variables
If nX = 0 Then
nX = 171
nY = 172
nZ = 170
End If

'first update variables
If nSeed <> 0 Then
If nSeed < 0 Then RandomizeX (nSeed)
nX = (171 * nX) Mod 30269
nY = (172 * nY) Mod 30307
nZ = (170 * nZ) Mod 30323
End If

'use variables to calculate output
nResult = nX / 30269# + nY / 30307# + nZ / 30323#
RndX = nResult - Int(nResult)

End Function

Sub ChartScatterPoints(ByVal vA As Variant, RowX As Long, RowY As Long, _
Optional sTitle As String = "", Optional sXAxis As String, _
Optional sYAxis As String)

'array input must contain two data rows for x and y data
'parameters for user title, x axis and y axis labels
'makes a simple point scatter chart

Dim LBC As Long, UBC As Long, LBR As Long, UBR As Long, n As Long, bOptLim As Boolean
Dim X As Variant, Y As Variant, sX As String, sY As String, sT As String, oC As Chart

LBR = LBound(vA, 1): UBR = UBound(vA, 1)
LBC = LBound(vA, 2): UBC = UBound(vA, 2)
ReDim X(LBC To UBC)
ReDim Y(LBC To UBC)

'labels for specific charts
If sTitle = "" Then sT = "Title Goes Here" Else sT = sTitle
If sXAxis = "" Then sX = "X Axis Label Goes Here" Else sX = sXAxis
If sYAxis = "" Then sY = "Y Axis Label Goes Here" Else sY = sYAxis

If RowX < LBR Or RowX > UBR Or RowY < LBC Or RowY > UBC Then
MsgBox "Parameter data rows out of range in ChartColumns - closing"
Exit Sub
End If

'transfer data to chart arrays
For n = LBC To UBC
X(n) = vA(RowX, n) 'x axis data
Y(n) = vA(RowY, n) 'y axis data
Next n

'make chart

'set chart type
ActiveChart.ChartType = xlXYScatter 'point scatter chart

'remove unwanted series
With ActiveChart
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
End With

'assign the data and labels to a series
With ActiveChart.SeriesCollection
If .Count = 0 Then .NewSeries
If Val(Application.Version) >= 12 Then
.Item(1).Values = Y
.Item(1).XValues = X
Else
.Item(1).Select
ExecuteExcel4Macro "series.x(!_)"
ExecuteExcel4Macro "series.y(,!_)"
Names("_").Delete
End If
End With

'apply title string, x and y axis strings, and delete legend
With ActiveChart
.HasTitle = True
.ChartTitle.Text = sT
.Axes(xlCategory).AxisTitle.Text = sX
.SetElement (msoElementPrimaryValueAxisTitleRotated) 'Y
.Axes(xlValue).AxisTitle.Text = sY
.Legend.Delete
End With

'trim axes to suit
With ActiveChart
'X Axis
.Axes(xlCategory).Select
.Axes(xlCategory).MinimumScale = 0
.Axes(xlCategory).MaximumScale = nSamples
.Axes(xlCategory).MajorUnit = 500
.Axes(xlCategory).MinorUnit = 100
Selection.TickLabelPosition = xlLow

'Y Axis
.Axes(xlValue).Select
.Axes(xlValue).MinimumScale = -0.2
.Axes(xlValue).MaximumScale = 1.2
.Axes(xlValue).MajorUnit = 0.1
.Axes(xlValue).MinorUnit = 0.05
End With

ActiveChart.ChartArea.Select

Set oC = Nothing

End Sub

Sub DeleteAllCharts5()
'run this to delete all ThisWorkbook charts

Dim oC

For Each oC In ThisWorkbook.Charts
oC.Delete
Next oC

End Sub

1. This is a SO link.