Version 1.0 Code
Dim InBall As Integer
Dim OutBall As Integer
Const BALL1ROW As Integer = 5
Const NUMBALLS As Integer = 20
Const INCOL As Integer = 2
Const OUTCOL As Integer = 3
Const CTCOL As Integer = 4
Const AVGCOL As Integer = 5
Const STDEVCOL As Integer = 6
Const UCLCOL As Integer = 7
Const LCLCOL As Integer = 8
Const CFDROW As Integer = 28
Const START_TIME_ROW As Integer = 3
Const START_TIME_COL As Integer = 10
Const INRATECOL = 2
Const OUTRATECOL = 3
Sub Start_Click()
Range("B5:H24").Clear
Range("B28:G45").Clear
Cells(START_TIME_ROW, START_TIME_COL).Value = Time
InBall = 1
OutBall = 1
End Sub
Sub In_Click()
InTime = Time - Cells(START_TIME_ROW, START_TIME_COL).Value
Row = (BALL1ROW - 1) + InBall
Call SetCellTime(Row, INCOL, InTime)
InBall = InBall + 1
End Sub
Sub Out_Click()
OutTime = Time - Cells(START_TIME_ROW, START_TIME_COL).Value
Row = (BALL1ROW - 1) + OutBall
Call SetCellTime(Row, OUTCOL, OutTime)
OutBall = OutBall + 1
End Sub
Sub Stop_Click()
CalculateCycleTimes
CalculateAverage
CalulateStdev
CalculateUCL
CalculateLCL
CalculateInRate
CalculateOutRate
CalculateCumulativeIn
CalculateCumulativeOut
CalculateCumulativeQueue
CalculateCumulativeWIP
End Sub
Sub CalculateCycleTimes()
For Row = BALL1ROW To (BALL1ROW + NUMBALLS - 1)
CycleTime = Cells(Row, OUTCOL).Value - Cells(Row, INCOL).Value
Call SetCellTime(Row, CTCOL, CycleTime)
Next Row
End Sub
Sub CalculateAverage()
AvgTime = Application.WorksheetFunction.Average(Range("D2:D24"))
Call FillCol(AVGCOL, AvgTime)
End Sub
Sub CalulateStdev()
StDev = Application.WorksheetFunction.StDevP(Range("D2:D24"))
Call FillCol(STDEVCOL, StDev)
End Sub
Sub CalculateUCL()
UCL = Range("E5").Value + (1 * Range("F5"))
Call FillCol(UCLCOL, UCL)
End Sub
Sub CalculateLCL()
LCL = Range("E5").Value - (1 * Range("F5"))
If LCL < 0 Then LCL = 0
Call FillCol(LCLCOL, LCL)
End Sub
Sub FillCol(Col, Val)
For Row = BALL1ROW To (BALL1ROW + NUMBALLS - 1)
Call SetCellTime(Row, Col, Val)
Next Row
End Sub
Sub SetCellTime(Row, Col, Val)
Cells(Row, Col).NumberFormat = "mm:ss"
Cells(Row, Col).Value = Val
End Sub
Sub CalculateInRate()
Call CalculateRate(INRATECOL)
End Sub
Sub CalculateOutRate()
Call CalculateRate(OUTRATECOL)
End Sub
Sub CalculateRate(Col)
Cadence = 1
Interval = 10
Count = 0
BallRow = BALL1ROW
TimeRow = CFDROW
Do
TimeVal = Cells(BallRow, Col).Value
CadenceTime = TimeSerial(0, 0, Cadence * Interval)
If TimeVal <= CadenceTime Then
Count = Count + 1
BallRow = BallRow + 1
Else
Cells(TimeRow, Col) = Count
Count = 0
TimeRow = TimeRow + 1
Cadence = Cadence + 1
End If
Loop While BallRow <= 24
Cells(TimeRow, Col) = Count
End Sub
Sub CalculateCumulativeIn()
CumIn = 0
Row = CFDROW
OutCount = Cells(Row, 3).Value
Do While OutCount <> ""
InCount = Cells(Row, 2).Value
CumIn = CumIn + InCount
Cells(Row, 4).Value = CumIn
Row = Row + 1
OutCount = Cells(Row, 3).Value
Loop
End Sub
Sub CalculateCumulativeOut()
CumOut = 0
Row = CFDROW
OutCount = Cells(Row, 3).Value
Do While OutCount <> ""
CumOut = CumOut + OutCount
Cells(Row, 5).Value = CumOut
Row = Row + 1
OutCount = Cells(Row, 3).Value
Loop
End Sub
Sub CalculateCumulativeQueue()
CumQueue = 0
Row = CFDROW
CumIn = Cells(Row, 4).Value
Do While CumIn <> ""
CumQueue = 20 - CumIn
Cells(Row, 6).Value = CumQueue
Row = Row + 1
CumIn = Cells(Row, 4).Value
Loop
End Sub
Sub CalculateCumulativeWIP()
CumWIP = 0
Row = CFDROW
CumIn = Cells(Row, 4).Value
CumOut = Cells(Row, 5).Value
CumWIP = CumIn - CumOut
Do While CumIn <> ""
Cells(Row, 7).Value = CumWIP
Row = Row + 1
CumIn = Cells(Row, 4).Value
CumOut = Cells(Row, 5).Value
CumWIP = CumIn - CumOut
Loop
End Sub