VBA Queueing Simulation Help Needed

[evbanewB]

Hello,

Thanks so much in advance for any help that you can provide me. I have been given code for a queueing simulation and I need to make it so that the simulation stops at the close time and the 'customers' that are currently in the system(nBusy) and in the queue(nInQueue) are reported. Currently, it is set up to not accept any new arrivals past the close time but will finish out the 'customers' in the queue. When I do make changes, I keep getting either a subscript out of range error or an overflow error. Any suggestions or tips would be so greatly appreciated! The code is below.

Option Explicit
Dim meanIATime As Single
Dim meanServeTime As Single
Dim nServers As Integer
Dim maxAllowedInQ As Integer
Dim closeTime As Single
Dim nInQueue As Integer
Dim nBusy As Integer
Dim clockTime As Single
Dim eventScheduled() As Boolean
Dim timeOfLastEvent As Single
Dim timeOfNextEvent() As Single
Dim nServed As Long
Dim nLost As Integer
Dim maxNInQueue As Integer
Dim maxTimeInQueue As Single
Dim timeOfArrival() As Single
Dim totalTimeInQueue As Single
Dim totalTimeBusy As Single
Dim sumOfQueueTimes As Single
Dim queueTimeArray() As Single
 
Sub Main()
Dim nextEventType As Integer
Dim finishedServer As Integer
Randomize
Call ClearOldResults
 
With wsReport
meanIATime = 1 / .Range("ArriveRate").Value
meanServeTime = .Range("MeanServeTime").Value
nServers = .Range("nServers").Value
maxAllowedInQ = .Range("MaxAllowedInQ").Value
closeTime = .Range("CloseTime").Value
End With
 
ReDim eventScheduled(nServers + 1)
ReDim timeOfNextEvent(nServers + 1)
 
Call Initialize
 
Do
 
Call FindNextEvent(nextEventType, finishedServer)
Call UpdateStatistics
If nextEventType = 1 Then
Call Arrival
Else
Call Departure(finishedServer)
End If
Loop Until Not eventScheduled(0) And nBusy = 0
 
Call Report
End Sub
 
Sub ClearOldResults()
With wsReport
.Range("Output_rng").ClearContents
With .Range("QDistAnchor")
Range(.Offset(1, 0), .Offset(0, 1).End(xlDown)).ClearContents
End With
End With
End Sub
 
Sub Initialize()
Dim i As Integer
clockTime = 0
nBusy = 0
nInQueue = 0
timeOfLastEvent = 0
nServed = 0
nLost = 0
sumOfQueueTimes = 0
maxTimeInQueue = 0
totalTimeInQueue = 0
maxNInQueue = 0
totalTimeBusy = 0
ReDim queueTimeArray(1)
queueTimeArray(0) = 0
eventScheduled(0) = True
timeOfNextEvent(0) = Exponential(meanIATime)
For i = 1 To nServers
eventScheduled(i) = False
Next
End Sub
 
Function Exponential(mean As Single) As Single
Exponential = -mean * Log(Rnd)
End Function
 
Sub FindNextEvent(nextEventType As Integer, finishedServer As Integer)
Dim i As Integer
Dim nextEventTime As Single
nextEventTime = 10 * closeTime
 
For i = 0 To nServers
If eventScheduled(i) Then
' If the current event is the most imminent so far, record it.
If timeOfNextEvent(i) < nextEventTime Then
nextEventTime = timeOfNextEvent(i)
If i = 0 Then
nextEventType = 1
Else
nextEventType = 2
finishedServer = i
End If
End If
End If
Next
clockTime = nextEventTime
End Sub
 
Sub UpdateStatistics()
Dim timeSinceLastEvent As Single, i As Integer
timeSinceLastEvent = clockTime - timeOfLastEvent
queueTimeArray(nInQueue) = queueTimeArray(nInQueue) + timeSinceLastEvent
totalTimeInQueue = totalTimeInQueue + nInQueue * timeSinceLastEvent
totalTimeBusy = totalTimeBusy + nBusy * timeSinceLastEvent
timeOfLastEvent = clockTime
End Sub
 
Sub Arrival()
Dim i As Integer
timeOfNextEvent(0) = clockTime + Exponential(meanIATime)
If timeOfNextEvent(0) > closeTime Then
eventScheduled(0) = False
End If
If nInQueue = maxAllowedInQ Then
nLost = nLost + 1
Exit Sub
End If
 
If nBusy = nServers Then
nInQueue = nInQueue + 1
If nInQueue > maxNInQueue Then
maxNInQueue = nInQueue
ReDim Preserve queueTimeArray(0 To maxNInQueue)
ReDim Preserve timeOfArrival(1 To maxNInQueue)
End If
timeOfArrival(nInQueue) = clockTime
Else
nBusy = nBusy + 1
 
For i = 1 To nServers
If Not eventScheduled(i) Then
eventScheduled(i) = True
timeOfNextEvent(i) = clockTime + Exponential(meanServeTime)
Exit For
End If
Next
End If
End Sub
 
Sub Departure(finishedServer As Integer)
Dim i As Integer
Dim timeInQueue As Single
nServed = nServed + 1
If nInQueue = 0 Then
nBusy = nBusy - 1
eventScheduled(finishedServer) = False
Else
nInQueue = nInQueue - 1
timeInQueue = clockTime - timeOfArrival(1)
If timeInQueue > maxTimeInQueue Then
maxTimeInQueue = timeInQueue
End If
sumOfQueueTimes = sumOfQueueTimes + timeInQueue
timeOfNextEvent(finishedServer) = clockTime + Exponential(meanServeTime)
For i = 1 To nInQueue
timeOfArrival(i) = timeOfArrival(i + 1)
Next
End If
End Sub
 
Sub Report()
 
 
Dim i As Integer
Dim avgTimeInQueue As Single
Dim avgNInQueue As Single
Dim avgNBusy As Single
Dim ser As Series
avgTimeInQueue = sumOfQueueTimes / nServed
avgNInQueue = totalTimeInQueue / clockTime
avgNBusy = totalTimeBusy / clockTime
 
For i = 0 To maxNInQueue
queueTimeArray(i) = queueTimeArray(i) / clockTime
Next
With wsReport
.Range("FinalTime").Value = clockTime
.Range("NServed").Value = nServed
.Range("AvgTimeInQ").Value = avgTimeInQueue
.Range("MaxTimeInQ").Value = maxTimeInQueue
.Range("AvgNInQ").Value = avgNInQueue
.Range("MaxNInQ").Value = maxNInQueue
.Range("AvgServerUtil").Value = avgNBusy / nServers
.Range("NLost").Value = nLost
.Range("PctLost").Formula = "=NLost/(NLost + NServed)"
 
 
With .Range("QDistAnchor")
For i = 0 To maxNInQueue
.Offset(i + 1, 0).Value = i
.Offset(i + 1, 1).Value = queueTimeArray(i)
Next
Range(.Offset(1, 0), .Offset(maxNInQueue, 0)).Name = "Report!NInQueue"
Range(.Offset(1, 1), .Offset(maxNInQueue, 1)).Name = "Report!PctOfTime"
End With
 
 
Set ser = .ChartObjects(1).Chart.SeriesCollection(1)
ser.Values = .Range("PctOfTime")
ser.XValues = .Range("nInQueue")
 
.Range("A2").Select
End With
End Sub
 
Sub ViewChangeInputs()
With wsReport
.Visible = True
.Activate
End With
Call ClearOldResults
End Sub