Normal Distribution Random Number Generator
This example shows the interested user how to create random numbers from a normal distribution given the standard deviation and the mean, and then computes the confidence interval given the level of significance, alpha. Cells C3 to C6 are input cells. Upon the completion of this program, the user can type in the alpha level, number of iterations, mean and standard deviation, then execute the Macro command to obtain the output. 

This program also generates a 20 class histogram as shown on figure 1. Twenty classes of frequency will be generated on cells I3 to I22. Users who are familiar with chart generation on Excel can use the data provided on cells H3 to I22 to generate a bell shaped histogram chart.

     

Check out other distributions on our site
The Log-Normal distribution random numbers generator allows you to generate random numbers on Excel sheet for your analysis. More disbribution...

'Option Explicit
Option Base 1

'***********************************************************************
'*            Normal Distribution Random Numbers Generator             *
'***********************************************************************

Sub normNo()

    Dim Iteration As Variant
    Dim mean As Variant
    Dim sd As Variant
    Dim alpha As Variant
    Dim i As Long
   
    Iteration = Range("c4").Value
    mean = Range("c5").Value
    sd = Range("c6").Value
    alpha = Range("c3").Value
    ReDim arr(Iteration) As Single
   
    For i = 1 To Iteration
        arr(i) = gauss * sd + mean
        Cells(6, 6) = i
    Next i
   
    Call Sort(Iteration, arr)
    Cells(3, 6) = arr(alpha / 2 * Iteration)
    Cells(4, 6) = arr((1 - alpha / 2) * Iteration)
    Call Hist(Iteration, 20, arr(1), arr(Iteration), arr)
   
End Sub

'***********************************************************************
'*  Return random numbers from Standard Normal Distribution    *
'***********************************************************************

Function gauss()

Dim fac As Double, r As Double, V1 As Double, V2 As Double
   
10  V1 = 2 * Rnd - 1
    V2 = 2 * Rnd - 1
    r = V1 ^ 2 + V2 ^ 2
    If (r >= 1) Then GoTo 10
    fac = Sqr(-2 * Log(r) / r)
    gauss = V2 * fac
   
End Function


'**********************************************************************
'*                                   Sort the numbers generated                           *
'**********************************************************************

Sub Sort(n As Variant, arr() As Single)

    Dim Temp As Double
    Dim i As Long
    Dim j As Long
   
    For j = 2 To n
        Temp = arr(j)
        For i = j - 1 To 1 Step -1
            If (arr(i) <= Temp) Then GoTo 10
            arr(i + 1) = arr(i)
        Next i
        i = 0
10      arr(i + 1) = Temp
    Next j
   
End Sub

'********************************************************************
'*                       Construct Historgram Distribution                          *
'********************************************************************

Sub Hist(n As Variant, M As Long, Start As Single, Right As Single, arr() As Single)

    Dim i As Long, j As Long, Find As Long
    Dim Length As Double
    ReDim breaks(M) As Single
    ReDim freq(M) As Single
   
    For i = 1 To M
        freq(i) = 0
    Next i
   
    Length = (Right - Start) / M
    For i = 1 To M
        breaks(i) = Start + Length * i
    Next i
   
    For i = 1 To n
        If (arr(i) <= breaks(1)) Then freq(1) = freq(1) + 1
        If (arr(i) >= breaks(M - 1)) Then freq(M) = freq(M) + 1
        For j = 2 To M - 1
            If (arr(i) > breaks(j - 1) And arr(i) <= breaks(j)) Then freq(j) = freq(j) + 1
        Next j
    Next i
   
    For i = 1 To M
        Cells(i + 2, 8) = breaks(i)
        Cells(i + 2, 9) = freq(i)
    Next i
   
End Sub



VBA Codes