Code

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