• If you would like to post, please check out the MrExcel Message Board FAQ and register here. If you forgot your password, you can reset your password.
  • Excel articles and downloadable files provided in the articles have not been reviewed by MrExcel Publishing. Please apply the provided methods / codes and open the files at your own risk. If you have any questions regarding an article, please use the Article Discussion section.
Worf

Animating a worksheet with VBA

Overview Discussion
Excel Version
  1. 2013
This is a demo version of a larger project. It shows how to animate a worksheet that does not quite look like one.

Here are the actions that can be performed:

  • Filling a tank
  • Recirculating a tank
  • Transferring water from one tank to another
To operate the pumps and valves, just click the corresponding buttons. Before switching a pump on, put it on manual mode at the bottom of the page,

  • The workbook link is below, it contains three sheets: main, alarm log and tanks sheet.
  • At the bottom of main, some alarms and messages are displayed.
  • When recirculating a tank, marching ants will highlight this operation.
  • There is a 50K character limit here so I cannot post all the code. The workbook of course is complete.
  • To reset the project, run the initial routine.


I believe the best way to understand all this is to download the workbook and play a bit with it.

I can provide further explanations if necessary…

Demo file

wsys.JPG


VBA Code: 
Option Explicit
Option Base 1
Public Const APPNAME$ = "main Help", Light& = 16777062, Dark& = 16711680
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex&) As Long
Public UserClick%, Prompt1$, Buttons1%, Title1
Dim ri%, ci%, rind%, cind%, rd%, cd%, ma() As Range
Dim LastAn#(2, 3), delta%, d1%, d2%

Sub FillBasin(bn%, level%, pn%)             ' from Oil
    Dim diff%
    If level = 1 Then delta = 4         ' pipe volume
    If level = 7 Then
        diff = 100 - basin(bn).ba(1)
        Randomize
        delta = (diff / 2) + (diff * Rnd) / 2
    End If
    If bn = 1 Then
        If Not pipe(13).full Then
            segs() = Array(25, 24, 23)
            rev() = Array(True, True, True)
            Anim_Rev Aqua, rdi, cdi, ordis, ldis, segs, rev, 13
            rev() = Array(False, False, False)
            segs() = Array(1, 2, 3)
            Anim_Rev Aqua, rsuc, csuc, orisuc, lens, segs, rev, 15
        End If
        Valve5
        Valve6 (1)
        d1 = delta
        d2 = 0
    ElseIf bn = 2 Then
        If Not pipe(19).full Then
            rev() = Array(False, False)
            segs() = Array(15, 16)
            Anim_Rev Aqua, rsuc, csuc, orisuc, lens, segs, rev, 19
            segs() = Array(10, 9, 8)
            rev() = Array(True, True, True)
            Anim_Rev Aqua, rdi, cdi, ordis, ldis, segs, rev, 26
        End If
        Valve12 (2)
        d2 = delta
        d1 = 0
    End If
    AnimateTwo d1, d2
    ThumbnailBasin (bn)
    BasinAlarm bn, pn
End Sub

Sub TransferBasin(orig%, dest%, pn%)
Dim destlevel
destlevel = Application.InputBox(Prompt:=Bw(10), Title:=Bw(11), Type:=1)
If TypeName(destlevel) = "Boolean" Or destlevel <= basin(dest).ba(1) Then
    If pump(pn).pd(6) Then ChangePump pn, orig
    pump(pn).la = "none"
    Exit Sub
End If
If destlevel > 100 Then destlevel = 100
If destlevel - basin(dest).ba(1) <= basin(orig).ba(1) Then
    delta = basin(dest).ba(1) - destlevel                 ' can reach desired level
Else
    delta = -basin(orig).ba(1)
End If
FlowDisplay dest, True
If pump(pn).pd(9) And (basin(orig).ba(1) + delta) <> 9 Then
    pump(pn).pd(9) = False
    Pump_Auto (pn)
    Application.Wait Now + TimeValue("0:00:01")
End If
If orig = 1 Then
    segs() = Array(15, 16)
    rev() = Array(False, False)
    Anim_Rev Aqua, rsuc, csuc, orisuc, lens, segs, rev, 19
    segs() = Array(10, 9, 8)
    rev() = Array(True, True, True)
    Anim_Rev Aqua, rdi, cdi, ordis, ldis, segs, rev, 26
    Valve12 (2)
    d1 = delta
    d2 = -delta
ElseIf orig = 2 Then
    segs() = Array(25, 24, 23)
    rev() = Array(True, True, True)
    Anim_Rev Aqua, rdi, cdi, ordis, ldis, segs, rev, 13
    rev() = Array(False, False, False)
    segs() = Array(1, 2, 3)
    Anim_Rev Aqua, rsuc, csuc, orisuc, lens, segs, rev, 15
    Valve5
    Valve6 (1)
    d2 = delta
    d1 = -delta
End If
If basin(dest).ba(1) = 0 Then
    For i = 1 To 3
        basin(dest).cval(i) = basin(orig).cval(i)
    Next i
Else
    For i = 1 To 3
        basin(dest).cval(i) = ((basin(orig).cval(i) * Abs(delta)) + (basin(dest).cval(i) * _
        basin(dest).ba(1))) / (basin(dest).ba(1) + Abs(delta))
    Next i
End If
AnimateTwo d1, d2
ThumbnailBasin (1)
ThumbnailBasin (2)
If pump(pn).pd(6) Then ChangePump pn, orig
BasinAlarm orig, pn
BasinAlarm dest, pn
Pump_Level dest
End Sub

Sub EmptyBasin(bn%, pn%)
Dim d1%, d2%
If basin(bn).ba(1) > 9 Then delta = 9 - basin(bn).ba(1)     ' level goes to 9%
If basin(bn).ba(1) <= 9 Then delta = -basin(bn).ba(1)       ' level goes to 0%
If bn = 1 Then
    d1 = delta
    d2 = 0
ElseIf bn = 2 Then
    d2 = delta
    d1 = 0
End If
AnimateTwo d1, d2
ThumbnailBasin bn
BasinAlarm bn, pn
ChangePump pn, bn
If pipe(30).full Then Range("bi47:bj47").Interior.ColorIndex = xlNone
If pump(pn).pd(5) And (Not f_meter(3)) Then ShowAlarm ("Sys" & Al(3) & "01/02/03" & Al(4)), False
End Sub

Sub AnimateTwo(d1%, d2%)
Dim j%, i%, delta%(2), mstep%(2), finish%
finish = 0
Sheets("tanks").Activate
delta(1) = d1
delta(2) = d2
For i = 1 To 2
    basin(i).ba(2) = basin(i).ba(1)
    basin(i).ba(3) = basin(i).ba(1) + delta(i)
    mstep(i) = 1
    If basin(i).ba(3) > 100 Then basin(i).ba(3) = 100
    If basin(i).ba(3) < 0 Then basin(i).ba(3) = 0
    If basin(i).ba(3) - basin(i).ba(1) < 0 Then mstep(i) = -1
Next i
If d1 <> 0 Then finish = Abs(d1)
If d2 <> 0 Then finish = Abs(d2)
For i = 1 To finish
    For j = 1 To 2
        If delta(j) <> 0 Then
            Sheets("tanks").Cells(1, j).Value = (basin(j).ba(1) + mstep(j)) / 100
            basin(j).ba(1) = basin(j).ba(1) + mstep(j)
        End If
    Next j
    Delay Unit
    DoEvents
Next i
Application.Wait Now + TimeValue("0:00:03")
Sheets("main").Activate
End Sub

Sub ThumbnailBasin(bnum%)
Dim levelnum%, count%
Select Case basin(bnum).ba(1)
    Case 0:                 levelnum = 0
    Case 1 To 15:           levelnum = 1
    Case 15 To 29:          levelnum = 2
    Case 29 To 43:          levelnum = 3
    Case 43 To 57:          levelnum = 4
    Case 57 To 71:          levelnum = 5
    Case 71 To 85:          levelnum = 6
    Case 85 To 100:         levelnum = 7
End Select
If bnum = 1 Then count = 0
If bnum = 2 Then count = 7
Application.ScreenUpdating = False
For i = 1 To 7
    PaintCells basin_ad(i + count), xlNone, "main"
Next i
For i = 1 To levelnum
    PaintCells basin_ad(i + count), Aqua, "main"
Next i
Application.ScreenUpdating = True
End Sub

Sub AnalyzeBasin(bn%)
Dim ct%
ct = 0
basin(bn).lv(2) = False
If basin(bn).ba(1) = 0 Then
    WarnWin warn(1) & bn & Bw(3)
    Exit Sub
End If
For i = 1 To 3
    LastAn(bn, i) = basin(bn).cval(i)
    If basin(bn).cval(i) >= MinAllow(i) And basin(bn).cval(i) <= MaxAllow(i) _
    Then ct = ct + 1
Next i
If ct = 3 Then
    basin(bn).lv(2) = True       ' approved
    basin(bn).lv(5) = False
End If
basin(bn).lv(1) = True
basin(bn).lv(4) = False
ShowParameters bn, False
End Sub

Sub ShowParameters(bn%, old As Boolean)
    Dim msg$, vd$(2), mb%, ws$(3), c%, mval#(3)
    c = 0
    For i = 1 To 3
        ws(i) = " "
    Next i
    If old Then
        For i = 1 To 3
            mval(i) = LastAn(bn, i)
        Next i
    Else
        For i = 1 To 3
            mval(i) = basin(bn).cval(i)
        Next i
    End If
    For i = 1 To 3
        If mval(i) < MinAllow(i) Or mval(i) > MaxAllow(i) Then
            ws(i) = " (*)":            c = c + 1
        End If
    Next i
    If c = 0 Then
        vd(1) = warn(1) & Bw(4)
        vd(2) = " "
        mb = vbInformation
    Else
        vd(1) = warn(1) & Bw(5)
        vd(2) = "(*) " & Bw(6)
        mb = vbExclamation
    End If
    msg = Bw(7) & bn & ":" & vbCrLf
    msg = msg & Bw(8) & " ---> " & Format(mval(1), "0.00") & " ppm"
    msg = msg & ws(1) & vbCrLf
    msg = msg & Bw(9) & "---> " & Format(mval(2), "0.00") & " ppm"
    msg = msg & ws(2) & vbCrLf
    msg = msg & "pH ---> " & Format(mval(3), "0.00") & ws(3) & vbCrLf
    msg = msg & vbCrLf & vd(2) & vbCrLf & vbCrLf & vd(1)
    MyMsgBox msg, mb, W2(6)
End Sub

Sub NewBasin(bn%)
    If basin(bn).ba(1) = 0 Then Exit Sub
    For i = 1 To 3
        basin(bn).cval(i) = MinVal(i) + (MaxVal(i) - MinVal(i)) * Rnd
    Next i
    basin(bn).lv(1) = False:         basin(bn).lv(2) = False
End Sub

Sub Addition(bn%)
    Dim ph#
    If basin(bn).cadd(2) Then                    'H2SO4
        If basin(bn).cval(3) < MaxAllow(3) Then
            basin(bn).cval(3) = basin(bn).cval(3) - 1
            If basin(bn).cval(3) < 0 Then basin(bn).cval(3) = 0
        Else
            basin(bn).cval(3) = 6 + 2 * Rnd
        End If
        basin(bn).cadd(2) = False
    End If
    If basin(bn).cadd(3) Then                    'NaOH
        Select Case basin(bn).cval(3)
            Case 0 To 5:                ph = 6 + 2 * Rnd
            Case 5 To 12:               ph = 12 + 0.2 * Rnd
            Case 12 To 14:              ph = basin(bn).cval(3) + 0.7
        End Select
        If ph > 14 Then ph = 14
        basin(bn).cval(3) = ph
        basin(bn).cadd(3) = False
    End If
    If basin(bn).cadd(1) Then                    'H2O2
        basin(bn).cval(1) = 0.5 + 0.4 * Rnd      ' N2H4
        basin(bn).cadd(1) = False
    End If
    If basin(bn).cval(3) >= 12 Then basin(bn).cval(2) = 3 + Rnd        ' NH3
End Sub

Sub BasinAlarm(bn%, pn%)
Select Case basin(bn).ba(3)
    Case 0 To 9
        If basin(bn).ba(2) >= 10 Then ShowAlarm "Sys0" & bn & Al(9) & bn & Al(10), False
    Case 10 To 80
        If basin(bn).ba(2) > basin(bn).ba(3) Then Blinker W2(7), pn
    Case 81 To 95
        If basin(bn).ba(2) < 81 Then ShowAlarm "Sys0" & bn & Al(7) & bn & Al(8), False
    Case 96 To 99
        If basin(bn).ba(2) < 81 Then ShowAlarm "Sys0" & bn & Al(7) & bn & Al(8), False
        If basin(bn).ba(2) < 96 Then ShowAlarm "Sys0" & bn & Al(1) & "0" & bn & Al(2), False
    Case 100
        If basin(bn).ba(2) < 81 Then ShowAlarm "Sys0" & bn & Al(7) & bn & Al(8), False
        If basin(bn).ba(2) < 96 Then ShowAlarm "Sys0" & bn & Al(1) & "0" & bn & Al(2), False
        If basin(bn).ba(2) < 100 Then ShowAlarm "Sys0" & bn & Al(5) & bn & Al(6), False
End Select
End Sub

Sub PaintCells(where, mcolor%, si$)
    Sheets(si).Range(where).Interior.ColorIndex = mcolor
    If ActiveSheet.Name = si Then Sheets(si).Range("a1").Select
End Sub

Sub Vis(pr%)
    Worksheets("f1").Visible = pr
    Worksheets("f2").Visible = pr
    Worksheets("f3").Visible = pr
End Sub

Sub ShowAlarm(als$, warn As Boolean)
    Dim lr%
    Application.Wait Now + TimeValue("0:00:01")
    If Not warn Then Range("h65") = als
    Application.ScreenUpdating = False
    Sheets("AlarmLog").Activate
    lr = LastRow + 1
    Range("a" & lr) = Date
    Range("b" & lr) = Time
    Range("c" & lr) = als
    Sheets("main").Activate
    Application.ScreenUpdating = True
    If Not warn Then Blinker "g65", 0
End Sub

Public Function LastRow() As Long
    If WorksheetFunction.CountA(Cells) = 0 Then
        LastRow = 0
        Exit Function
    End If
    LastRow = Cells.Find(what:="*", after:=[a1], searchorder:=xlByRows, _
    searchdirection:=xlPrevious).Row
End Function

Sub Blinker(where, pn%)
    Application.Wait Now + TimeValue("0:00:01")
    If pn <> 0 Then
        If pump(pn).pd(8) Then Exit Sub
        pump(pn).pd(9) = False
        Pump_Auto pn
        If pn = 7 Then Range("az60") = 2
        If pn = 8 Then Range("az60") = 3
        If pn = 9 Then Range("az60").Value = 1
        pump(pn).pd(8) = True
    End If
    For i = 1 To 5
        Range(where).Interior.ColorIndex = Yellow2
        Delay Unit * 10
        Range(where).Interior.ColorIndex = Black
        Delay Unit * 20
   Next i
End Sub

Sub Anim_All(ByVal pn%, mcolor%, str1(), stc(), orien, leng(), ord%(), count%)
Dim j%, cell As Range, i%
If count = 10 Then                                          ' 2Oil
    pn = pn - 3
    Range("aa1").Activate
End If
For i = 1 To count
    Direction orien(ord(pn, i))
    For j = 1 To leng(ord(pn, i))
        Set cell = ActiveCell.Offset(str1(ord(pn, i)) + rind, stc(ord(pn, i)) + cind)
        Range(cell.Address).Interior.ColorIndex = mcolor
        rind = rind + ri
        cind = cind + ci
        Delay Unit
    Next j
Next i
If count = 9 Then
    If mcolor = Aqua Then pipe(4).full = True
    If mcolor = xlNone Then pipe(4).full = False
ElseIf count = 10 Then
    If mcolor = Aqua Then pipe(10).full = True
    If mcolor = xlNone Then pipe(10).full = False
End If
End Sub

Sub Anim_Rev(mcolor%, ra(), ca(), oriar, lenar(), segs(), rev(), pi)
Dim j%, cell As Range
If mcolor = Aqua And pipe(pi).full Then Exit Sub
If mcolor = xlNone And (Not pipe(pi).full) Then Exit Sub
Range("a1").Activate
If mcolor = Aqua Then pipe(pi).full = True
If mcolor = xlNone Then pipe(pi).full = False
For i = 1 To UBound(segs)
    Direction oriar(segs(i))
    rd = ra(segs(i))
    cd = ca(segs(i))
    RevAn rev(i), oriar(segs(i)), lenar(segs(i))
    For j = 1 To lenar(segs(i))
        Set cell = ActiveCell.Offset(rd + rind, cd + cind)
        Range(cell.Address).Interior.ColorIndex = mcolor
        rind = rind + ri
        cind = cind + ci
        Delay Unit
    Next
Next i
End Sub

Sub AfterValves(vn%, mcolor%)
Dim count%, si%, j%, cell As Range, val_orien, vroff(), vcoff(), val_len()
vroff() = Array(9, 2, 3, 5, 6, 9)
vcoff() = Array(22, 28, 42, 31, 27, 38)
val_orien = Array("d", "r", "d", "l", "d", "d")
val_len() = Array(3, 15, 9, 5, 6, 3)
Range("a1").Activate
Select Case vn
    Case 1
        count = 1
        si = 0
    Case 2
        count = 2
        si = 1
    Case 3
        count = 2
        si = 3
    Case 4
        count = 1
        si = 5
End Select
For i = 1 To count
    Direction val_orien(si + i)
    For j = 1 To val_len(si + i)
        Set cell = ActiveCell.Offset(vroff(si + i) + rind, vcoff(si + i) + cind)
        Range(cell.Address).Interior.ColorIndex = mcolor
        rind = rind + ri
        cind = cind + ci
        Delay Unit
    Next j
Next i
End Sub

Sub Direction(ori)
    Select Case ori
        Case "u"
            ri = -1:               ci = 0
        Case "d"
            ri = 1:                ci = 0
        Case "l"
            ri = 0:                ci = -1
        Case "r"
            ri = 0:                ci = 1
    End Select
    rind = 0:                      cind = 0
End Sub

Sub Delay(nb#)
    Dim c&, m#
    For c = 1 To nb
        m = (c / (c + 1) * 0.4) + 5.9
    Next c
End Sub

Sub FlowDisplay(id%, wat As Boolean)            ' real value = 377 m3/h
Application.Wait Now + TimeValue("0:00:01")
If wat Then
    f_meter(id) = True
    Randomize
    Range(FlowInd(id)).Value = (360 + 30 * Rnd)
Else
    f_meter(id) = False
    Range(FlowInd(id)).Value = 0
End If
End Sub

Function Calc_Unit(sv%) As Double
    If sv < 51 Then
        Calc_Unit = 4982 * Exp(-0.04 * sv)
    Else
        Calc_Unit = (-0.169 * (sv ^ 2)) + 13.58 * sv + 393
    End If
    Calc_Unit = Round(Calc_Unit * 1000)
End Function

Sub AnCore(si%, di%)
Dim k%, j%
d1 = 0
d2 = 0
For i = 1 To nssuc(si)
    d1 = d1 + lens(sucway(si, i))
Next i
For i = 1 To nsdis(di)
    d2 = d2 + ldis(disway(di, i))
Next i
Range("a1").Activate
k = 1
ReDim ma(d1 + d2)
For i = 1 To nssuc(si)
    Direction orisuc(sucway(si, i))
    rd = rsuc(sucway(si, i))
    cd = csuc(sucway(si, i))
    RevAn sucbol(si, i), orisuc(sucway(si, i)), lens(sucway(si, i))
    For j = 1 To lens(sucway(si, i))
        Set ma(k) = ActiveCell.Offset(rd + rind, cd + cind)
        k = k + 1
        rind = rind + ri
        cind = cind + ci
    Next j
Next i
For i = 1 To nsdis(di)
    Direction ordis(disway(di, i))
    rd = rdi(disway(di, i))
    cd = cdi(disway(di, i))
    RevAn disbol(di, i), ordis(disway(di, i)), ldis(disway(di, i))
    For j = 1 To ldis(disway(di, i))
        Set ma(k) = ActiveCell.Offset(rd + rind, cd + cind)
        k = k + 1
        rind = rind + ri
        cind = cind + ci
    Next j
Next i
For j = 1 To 10
    Anim Light, Dark, d1 + d2
    Delay Unit * 8
    Anim Dark, Light, d1 + d2
    Delay Unit * 8
Next j
Anim Light, Light, d1 + d2
End Sub

Sub Anim(c1&, c2&, tot%)
Dim mv%, sv%
If (tot Mod 2) = 0 Then
    mv = tot - 1:            sv = tot
Else
    mv = tot:                sv = tot - 1
End If
For i = 1 To mv Step 2
    Range(ma(i).Address).Interior.Color = c1
Next i
For i = 2 To sv Step 2
    Range(ma(i).Address).Interior.Color = c2
Next i
End Sub

Sub End_Anim()
    Anim Light, Light, d1 + d2
End Sub

Sub Continue()
Dim rec As Boolean
Pump7 False
Pump8 False
Pump9 False
rec = False
For i = 7 To 9
    If pump(i).pd(6) Then
        If pump(i).pd(1) And pump(i).pd(3) Then rec = True
        If pump(i).pd(2) And pump(i).pd(4) Then rec = True
    End If
Next i
If rec Then AnCore suc, dis
End Sub

Sub RevAn(ByVal bv As Boolean, ByVal ori$, ByVal leng%)
If bv Then
        Select Case ori
            Case "u"
                ri = 1:                ci = 0
                rd = rd - leng + 1
            Case "d"
                ri = -1:               ci = 0
                rd = rd + leng - 1
            Case "l"
                ri = 0:                ci = 1
                cd = cd - leng + 1
            Case "r"
                ri = 0:                ci = -1
                cd = cd + leng - 1
        End Select
    End If
End Sub

Sub WarnWin(ByVal st$)
Range("h67") = st
Application.Speech.Speak "Message"
For i = 1 To 5
    Range("h67").Font.Color = RGB(200, 189, 100)
    Delay Unit * 15
    Range("h67").Font.Color = RGB(100, 189, 200)
    Delay Unit * 10
Next
Range("h67") = " "
ShowAlarm st, True
End Sub

Sub SK()
SendKeys "^{F4}"
End Sub

VBA Code: 
Option Base 1
Option Explicit
Public Type Dbasin
    ba(3) As Integer        '1=percent level        2=starting level    3=final
    lv(5) As Boolean        '1=analyzed      2=approved   3=recirc info  4=analysis info    5=approval info
    cval(3) As Double       ' chemicals values
    cadd(3) As Boolean      ' chemicals added or not
End Type
Public Type Valves
    opn As Boolean          ' opened or not
    ind As String
End Type
Public Type Pumps
    lc(9) As Boolean
    la As String            ' last action
    ind As String
    pd(9) As Boolean        '1=from 1   2=from 2    3=to 1      4=to 2      5=to the sea
End Type                    '6=on       7=checked   8=blink     9=auto
Public Type Mpipe
    full As Boolean
End Type

Public Const Aqua& = 8, Red& = 3, Green& = 4, Yellow& = 10092543, Black& = 1, Yellow2& = 6
Public pipe(31) As Mpipe, pump(9) As Pumps, vv(26) As Valves, warn(), _
i%, basin(2) As Dbasin, basin_ad, PumpLog(), answered As Boolean, _
MinVal(), MaxVal(), MinAllow(), f_meter(3) As Boolean, _
W2(), MaxAllow(), Bw(), Al(), noal(2) As Boolean, order%(3, 9), _
leng(), str1(), stc(), orien, ord2%(3, 10), stc2(), orien2, leng2(), str2(), _
rsuc(), csuc(), orisuc, lens(), rev(), segs(), rdi(), cdi(), ordis, ldis(), _
FlowInd(), tn$, PDis, Unit#, sucway%(6, 11), nssuc(), _
bigsuc(), bigdis(), disway%(10, 16), nsdis(), blogsuc(), _
sucbol%(6, 11), disbol%(10, 16), blogdis(), suc%, dis%, d1%, d2%

Sub Initial()
Dim VvInd(), PumpInd(), j%, k%, c%, aux(), aux2()
Application.ScreenUpdating = False
answered = False
MinVal() = Array(0, 0, 2)       ' N2H4, NH3, pH
MaxVal() = Array(5, 13, 12)
MinAllow() = Array(0, 0, 5)
MaxAllow() = Array(1, 6, 9)
basin_ad = Array("u20:ac20", "u19:ac19", "u18:ac18", "u17:ac17", "u16:ac16", "u15:ac15", _
"u14:ac14", "ak20:as20", "ak19:as19", "ak18:as18", "ak17:as17", "ak16:as16", _
"ak15:as15", "ak14:as14")
VvInd() = Array("x9:x10", "aa1:ab1", "ag8:ah8", "al9:al10", "f34:f35", "k31:k32", _
"q33:q34", "q42:q43", "x32:y32", "x41:y41", "x49:y49", "ah24:ai24", "ag55:ah55", _
"an28:ao28", "an37:ao37", "an45:ao45", "bl27:bl28", "as34:as35", "as42:as43", "bg34:bg35", _
"ba49:bb49", "bg49:bh49", "bg49:bh49")
FlowInd() = Array("aq49", "bl33", "bh52")
PumpInd() = Array("e17:g17", "h17:j17", "k17:m17", "bb23:bd23", "be23:bg23", "bh23:bj23", _
"ah33:ai33", "ah42:ai42", "ah50:ai50")
warn() = Array("tank", "full", "pump", "not available", _
"Error ", "discharge", "blocked", "pump", "pump", _
"pump", "Recirculating ", "Transferring ", " to ", "Discharging ", " to the sea", _
"suction", "discharge")
Sheets("main").Activate
ActiveSheet.Range("h65") = " "
ActiveSheet.Range("az60") = " "
PumpLog() = Array("ad59", "ad60", "ad61")
W2() = Array(" not analyzed", "no function...", _
"No tank selected", "Tank 1", "Tank 2", "Software", "bb62:be62", "save ")
Unit = Calc_Unit(Sheets("tanks").Range("d8").Value)
Bw() = Array(" maximum level", " overflow", " empty", _
"can be discharged", " no license", "out of spec", "tank ", _
"N2H4", "NH3", "Inform desired level on target tank: ", _
"Inform percent value without % symbol", "No product selected")
Al() = Array("level", "level", "flow", "flow", "level", "level", "level", _
"level", "level", "level")
str1() = Array(10, 4, 5, 4, 5, 4, 3, 2, 3, 10, 4, 5, 10, 4)
stc() = Array(5, 6, 8, 9, 11, 4, 2, 3, 22, 8, 7, 5, 11, 10)
aux() = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 4, 5, 11, 12, 6, 7, 8, 9, _
 13, 14, 3, 11, 12, 6, 7, 8, 9)
aux2() = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 4, 5, 6, 7, 8, 9, 10, _
14, 15, 3, 12, 13, 6, 7, 8, 9, 10)
orien = Array("u", "r", "d", "r", "d", "l", "u", "r", "d", "u", "l", "d", "u", "l")
leng() = Array(7, 3, 3, 3, 3, 3, 2, 23, 6, 7, 3, 3, 7, 3)
str2() = Array(16, 8, 9, 8, 9, 8, 7, 5, 5, 6, 16, 8, 9, 16, 8)
stc2() = Array(28, 29, 31, 32, 34, 35, 37, 36, 14, 12, 31, 30, 28, 34, 33)
orien2 = Array("u", "r", "d", "r", "d", "r", "u", "l", "l", "d", "u", "l", "d", "u", "l")
leng2() = Array(9, 3, 3, 3, 3, 3, 3, 19, 7, 2, 9, 3, 3, 9, 3)
Application.OnKey "{DOWN}", "Continue"
orisuc = Array("d", "l", "d", "d", "r", "r", "u", "u", "r", "u", "u", "r", "u", "r", _
"d", "l", "r", "r", "r", "u", "u", "u")
lens() = Array(4, 11, 6, 14, 6, 4, 2, 3, 4, 3, 3, 4, 4, 13, 6, 4, 6, 6, 6, 5, 4, 3)
rdi() = Array(29, 29, 32, 29, 32, 29, 29, 25, 24, 23, 38, 38, 37, 39, 44, 46, 46, 46, 46, _
47, 52, 52, 32, 21, 21, 45, 46, 46, 52, 46, 38, 46, 32, 46, 32)
cdi() = Array(35, 41, 46, 47, 56, 57, 61, 61, 60, 42, 35, 41, 46, 46, 46, 35, 41, 47, 50, _
49, 48, 31, 7, 8, 21, 56, 54, 56, 7, 49, 46, 41, 46, 54, 56)
ordis = Array("r", "r", "u", "r", "u", "r", "u", "u", "l", "u", "r", "r", "u", "d", "d", "r", _
"r", "r", "r", "d", "l", "l", "u", "r", "u", "u", "r", "r", "u", "r", "u", "r", "u", "r", "u")
ldis() = Array(4, 6, 3, 10, 3, 4, 2, 2, 19, 4, 4, 6, 2, 2, 3, 4, 5, 3, 2, 6, 13, 24, 12, _
13, 2, 10, 2, 2, 17, 3, 3, 6, 4, 3, 4)
rsuc() = Array(20, 23, 24, 33, 46, 46, 45, 40, 38, 37, 31, 29, 28, 25, 20, 25, 29, 38, 46, 29, 38, 46)
csuc() = Array(23, 22, 12, 12, 13, 19, 18, 18, 19, 18, 18, 19, 18, 19, 38, 37, 25, 25, 25, 18, 18, 18)
blogsuc() = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, _
0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0)
blogdis() = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, _
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, _
0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, _
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, _
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
bigdis() = Array(16, 32, 18, 20, 21, 22, 29, 23, 24, 25, _
16, 17, 15, 14, 31, 33, 4, 6, 7, 8, 9, 10, _
16, 32, 18, 19, 34, 26, 35, 6, 7, 8, 9, 10, 1, 2, 3, 31, 14, 15, 18, 20, 21, 22, 29, 23, 24, 25, _
1, 2, 4, 5, 26, 34, 30, 20, 21, 22, 29, 23, 24, 25, 1, 2, 4, 6, 7, 8, 9, 10, _
11, 12, 14, 15, 18, 20, 21, 22, 29, 23, 24, 25, _
11, 12, 13, 33, 4, 5, 26, 34, 30, 20, 21, 22, 29, 23, 24, 25, _
11, 12, 13, 33, 4, 6, 7, 8, 9, 10, 11, 12, 14, 15, 18, 19, 34, 26, 35, 6, 7, 8, 9, 10)
nsdis() = Array(10, 12, 12, 14, 14, 8, 12, 16, 10, 14)
bigsuc() = Array(1, 2, 3, 4, 5, 6, 19, 15, 16, 14, 13, 11, 10, 8, 22, 6, 19, _
1, 2, 3, 4, 5, 7, 8, 10, 11, 12, 17, _
15, 16, 14, 20, 12, 17, 1, 2, 3, 4, 5, 7, 8, 9, 18, 15, 16, 14, 13, 11, 21, 9, 18)
nssuc() = Array(7, 10, 11, 6, 9, 8)
k = 1
For i = 1 To UBound(nsdis)
    For j = 1 To nsdis(i)
        disway(i, j) = bigdis(k)
        disbol(i, j) = blogdis(k)
        k = k + 1
    Next j
Next i
k = 1
For i = 1 To UBound(nssuc)
    For j = 1 To nssuc(i)
        sucway(i, j) = bigsuc(k)
        sucbol(i, j) = blogsuc(k)
        k = k + 1
    Next
Next i
PDis = Array("f10:f12", "i10:i12", "l10:l12", "bc15:bc17", "bf15:bf17", "bi15:bi17")

PaintCells "a1:bo55", xlNone, "main"
c = 1
For i = 1 To 3
    Range(FlowInd(i)).Interior.Color = Yellow
    Range(FlowInd(i)) = 0
    For j = 1 To 9
        order(i, j) = aux(c)
        c = c + 1
    Next j
Next i
c = 1
For i = 1 To 3
    For j = 1 To 10
        ord2(i, j) = aux2(c)
        c = c + 1
    Next
Next i
j = 1
For i = 1 To 31
    pipe(i).full = False
Next i
Application.StatusBar = W2(6)
For i = 1 To 23
    PaintCells VvInd(i), Red, "main"
    vv(i).ind = VvInd(i)
    vv(i).opn = False
Next
For i = 1 To 2
    noal(i) = False
    Sheets("tanks").Cells(1, i) = 0
    For j = 1 To 5
        basin(i).lv(j) = False
    Next j
    For j = 1 To 3
        basin(i).cval(j) = 0:           basin(i).ba(j) = 0
        basin(i).cadd(j) = False:       f_meter(j) = False
        Sheets("main").Range(PumpLog(j)).Value = "AUTO"
    Next j
Next i
For i = 1 To 9
    PaintCells PumpInd(i), Red, "main"
    pump(i).ind = PumpInd(i)
    pump(i).la = "none"
    For j = 1 To 9
        pump(i).pd(j) = False:        pump(i).lc(j) = False
    Next
    pump(i).pd(9) = True
Next i
Application.ScreenUpdating = True
End Sub

Sub S_12Oil(pn%, vn%, ni$, ds%, ups%, bv As Boolean, ds2%)
If vv(vn).opn Then
    If basin(1).ba(1) = 100 Then
        WarnWin warn(1) & " 1" & Bw(2)
        If pump(pn).pd(6) Then
            pump(pn).pd(6) = False
            PaintCells pump(pn).ind, Red, "main"
        End If
        Exit Sub
    End If
ElseIf vv(vn + 1).opn Then
    If basin(2).ba(1) = 100 Then
        WarnWin warn(1) & " 2" & Bw(2)
        If pump(pn).pd(6) Then
            pump(pn).pd(6) = False
            PaintCells pump(pn).ind, Red, "main"
        End If
        Exit Sub
    End If
End If
pump(pn).pd(6) = Not pump(pn).pd(6)
If pump(pn).pd(6) Then
    If vv(vn).opn And vv(vn + 1).opn Then
        WarnWin warn(5) & warn(17) & " - " & ni & "Oil"
        If pump(pn).pd(6) Then pump(pn).pd(6) = False
        Exit Sub
    End If
    PaintCells pump(pn).ind, Green, "main"
    PaintCells PDis(pn), Aqua, "main"
    If ni = "1" Then
        If Not pipe(4).full Then Anim_All pn, Aqua, str1, stc, orien, leng, order, 9
    ElseIf ni = "2" Then
        If Not pipe(10).full Then Anim_All pn, Aqua, str2, stc2, orien2, leng2, ord2, 10
    End If
    Valves_Oil vn, pn, ds, 1, ups, bv
    Valves_Oil vn + 1, pn, ds2, 2, ups, bv
Else
    PaintCells PDis(pn), xlNone, "main"
    PaintCells pump(pn).ind, Red, "main"
End If
End Sub

Function bp(from_b As Boolean, bn%, pn%) As Boolean
bp = False
If from_b Then
        If Not basin(bn).lv(1) Then
            If Not basin(bn).lv(4) Then
                If basin(bn).ba(1) <> 0 Then WarnWin warn(1) & bn & W2(1)
                basin(bn).lv(4) = True
            End If
            If pump(pn).pd(6) Then
                Blinker W2(7), pn
                ChangePump pn, pn
            End If
            bp = True
            Exit Function
        Else
            If Not basin(bn).lv(2) Then         ' not approved
                If Not basin(bn).lv(5) Then
                    If pump(pn).pd(5) Then WarnWin warn(1) & bn & Bw(5)
                    basin(bn).lv(5) = True
                End If
                If pump(pn).pd(6) Then
                    Blinker W2(7), pn
                    ChangePump pn, pn
                End If
                bp = True
            End If
        End If
    End If
End Function

Sub PumpAlarm(pn%)                       ' lost flow
Dim pin$
tn = "0"
Select Case pn
    Case 7:        pin = "02"
    Case 8:        pin = "03"
    Case 9:        pin = "01"
End Select
If pump(pn).la = "rec1" Or pump(pn).la = "trf2to1" Then tn = "1"
If pump(pn).la = "rec2" Or pump(pn).la = "trf1to2" Then tn = "2"
Select Case pn
    Case 7
        Parallel 8, 9           ' two pumps on at same time
    Case 8
        Parallel 7, 9
    Case 9
        Parallel 7, 8
End Select
If tn <> "0" Then
    If Not noal(CVar(tn)) Then ShowAlarm "Sys0" & tn & Al(3) & pin & Al(4), False    'low flow
    noal(CVar(tn)) = False
End If
pump(pn).la = "none"
End Sub

Sub Pump_Auto(pn%)
    If pump(pn).pd(9) Then
        Range(PumpLog(pn - 6)).Value = "AUTO"
    Else
        Range(PumpLog(pn - 6)).Value = "MANUAL"
    End If
End Sub

Sub Pump_Level(bn%)
Select Case bn
   Case 1
    If Not pump(9).pd(6) And basin(1).ba(1) > 80 And basin(1).ba(2) <= 80 And pump(9).pd(9) Then
        ChangePump 9, 1
        Pump9 True
    End If
    If (Not pump(8).pd(6)) And vv(8).opn And basin(1).ba(1) > 80 And basin(1).ba(2) <= 80 _
    And pump(8).pd(9) Then
        ChangePump 8, 1
        Pump8 True
    End If
   Case 2
    If Not pump(7).pd(6) And basin(2).ba(1) > 80 And basin(2).ba(2) <= 80 And pump(7).pd(9) Then
        ChangePump 7, 2
        Pump7 True
    End If
    If (Not pump(8).pd(6)) And vv(7).opn And basin(2).ba(1) > 80 And basin(2).ba(2) <= 80 _
    And pump(8).pd(9) Then
        ChangePump 8, 2
        Pump8 True
    End If
End Select
End Sub

Sub Parallel(fp%, sp%)
If tn = "1" Then
    If pump(fp).pd(6) And (pump(fp).la = "rec1" Or pump(fp).la = "trf2to1") Then tn = "0"
    If pump(sp).pd(6) And (pump(sp).la = "rec1" Or pump(sp).la = "trf2to1") Then tn = "0"
ElseIf tn = "2" Then
    If pump(fp).pd(6) And (pump(fp).la = "rec2" Or pump(fp).la = "trf1to2") Then tn = "0"
    If pump(sp).pd(6) And (pump(sp).la = "rec2" Or pump(sp).la = "trf1to2") Then tn = "0"
End If
End Sub

Function YComp(bn%, pn%) As Boolean
YComp = True
If basin(bn).ba(1) > 80 And pump(pn).pd(9) Then pump(pn).lc(1) = True        'automatic on
If basin(bn).ba(1) < 10 And pump(pn).pd(9) Then pump(pn).lc(2) = True        'automatic off
If pump(pn).lc(1) And Not f_meter(3) And Not f_meter(bn) Then                'protective off
    pump(pn).lc(3) = True
    Application.Wait Now + TimeValue("0:00:04")
End If
If Not pump(pn).lc(2) And Not pump(pn).lc(3) Then YComp = False
End Function

Function YF(pn%) As Boolean
YF = True
For i = 1 To 9
    pump(pn).lc(i) = False
Next i
Select Case pn
    Case 9
        If Not YComp(1, 9) Then YF = False
    Case 7
        If Not YComp(2, 7) Then YF = False
    Case 8
        If pump(8).pd(9) And basin(1).ba(1) > 80 And vv(8).opn Then pump(pn).lc(1) = True
        If pump(8).pd(9) And basin(2).ba(1) > 80 And vv(7).opn Then pump(pn).lc(2) = True
        If pump(pn).lc(1) Or pump(pn).lc(2) Then pump(pn).lc(3) = True
        If pump(8).pd(9) And basin(1).ba(1) < 10 And vv(8).opn Then pump(pn).lc(4) = True
        If pump(8).pd(9) And basin(2).ba(1) < 10 And vv(7).opn Then pump(pn).lc(5) = True
        If pump(pn).lc(4) Or pump(pn).lc(5) Then pump(pn).lc(6) = True
        If Not f_meter(2) Or Not vv(7).opn Then pump(pn).lc(7) = True
        If Not f_meter(1) Or Not vv(8).opn Then pump(pn).lc(8) = True
        If pump(pn).lc(7) And pump(pn).lc(8) And pump(pn).lc(3) And Not f_meter(3) Then
            pump(pn).lc(9) = True
            Application.Wait Now + TimeValue("0:00:05")
        End If
        If Not pump(pn).lc(6) And Not pump(pn).lc(9) Then YF = False    ' needs Blinker
End Select
End Function

Function CheckDis(pn%) As Boolean
CheckDis = True
    i = 0
    If pump(pn).pd(3) Then i = i + 1
    If pump(pn).pd(4) Then i = i + 1
    If pump(pn).pd(5) Then i = i + 1
    If i > 1 Then CheckDis = False
End Function

Function Prob%(pn%)    ' avoids simultaneous pumping or discharging to
Dim a%, b%                      ' the same tank
Prob = 0
Select Case pn
    Case 7
        a = 8:        b = 9
    Case 8
        a = 7:        b = 9
    Case 9
        a = 7:        b = 8
End Select
For i = 1 To 4
    If pump(pn).pd(i) Then
        If pump(a).pd(6) And pump(a).pd(i) Then Prob = i
        If pump(b).pd(6) And pump(b).pd(i) Then Prob = i
    End If
Next i
If Prob <> 0 And Prob < 3 Then                  ' suction
    Prob = 16
    Exit Function
End If
If Prob <> 0 And Prob > 2 Then Prob = 17        ' discharge
End Function

Sub DisValve(dp%, pn%)
    If pipe(dp).full Then
        Select Case pn
            Case 7:            Valve14
            Case 8:            Valve15
            Case 9:            Valve16
        End Select
    End If
End Sub
Sub Pump7(bp As Boolean)
For i = 1 To 5
    pump(7).pd(i) = False
Next i
If (vv(6).opn And vv(8).opn And vv(7).opn And vv(9).opn) Then pump(7).pd(1) = True
If vv(12).opn And vv(9).opn Then pump(7).pd(2) = True
If (vv(5).opn And vv(13).opn And vv(19).opn And vv(18).opn And _
vv(14).opn) Then pump(7).pd(3) = True
If (vv(5).opn And vv(13).opn And vv(21).opn And vv(20).opn And vv(14).opn) Then _
pump(7).pd(3) = True
If (vv(14).opn And vv(17).opn) Then pump(7).pd(4) = True
If (vv(14).opn And vv(20).opn And vv(22).opn) Then pump(7).pd(5) = True
If (vv(14).opn And vv(18).opn And vv(19).opn And _
vv(22).opn And vv(21).opn) Then pump(7).pd(5) = True
If bp Then BigPump 7, 20, 23
End Sub

Sub Pump8(bp As Boolean)
For i = 1 To 5
    pump(8).pd(i) = False
Next
If (vv(6).opn And vv(8).opn And vv(10).opn) Then pump(8).pd(1) = True
If (vv(12).opn And vv(7).opn And vv(10).opn) Then pump(8).pd(2) = True
If (vv(15).opn And vv(19).opn And vv(13).opn And vv(5).opn) Then pump(8).pd(3) = True
If (vv(15).opn And vv(18).opn And vv(20).opn _
And vv(21).opn And vv(13).opn And vv(5).opn) Then pump(8).pd(3) = True
If (vv(15).opn And vv(18).opn And vv(17).opn) Then pump(8).pd(4) = True
If (vv(15).opn And vv(19).opn And vv(21).opn _
And vv(20).opn And vv(17).opn) Then pump(8).pd(4) = True
If (vv(15).opn And vv(19).opn And vv(22).opn And vv(21).opn) Then pump(8).pd(5) = True
If (vv(15).opn And vv(18).opn And vv(22).opn And vv(20).opn) Then pump(8).pd(5) = True
If bp Then BigPump 8, 21, 24
End Sub

Sub Pump9(bp As Boolean)
For i = 1 To 5
    pump(9).pd(i) = False
Next i
If (vv(6).opn And vv(11).opn) Then pump(9).pd(1) = True
If vv(11).opn And vv(8).opn And vv(7).opn And vv(12).opn Then pump(9).pd(2) = True
If vv(16).opn And vv(13).opn And vv(5).opn Then pump(9).pd(3) = True
If (vv(16).opn And vv(19).opn And vv(18).opn And vv(17).opn) Then pump(9).pd(4) = True
If (vv(16).opn And vv(21).opn And vv(20).opn And vv(17).opn) Then pump(9).pd(4) = True
If (vv(16).opn And vv(22).opn And vv(21).opn) Then pump(9).pd(5) = True
If (vv(16).opn And vv(19).opn And vv(18).opn And vv(20).opn _
And vv(22).opn) Then pump(9).pd(5) = True
If bp Then BigPump 9, 22, 25
End Sub

Sub CleanS7_9(p1%, p2%, p3%, p4%, p5%, p6%, p7%, p8%, pn%, v1%, v2%, v3%, v4%, v5%, v6%, v7%)
Dim do_it(8) As Boolean, wseg(), bseg(), to_drain(8), seg_data(19), rev_data(19), n_segs(8), _
j%, k%, did As Boolean, c%, td7(), td9(), ns7(), auv%, ns9(), sd7(), sd9(), rd7(), rd9()
td7() = Array(22, 15, 16, 21, 17, 19, 18, 20)
td9() = Array(19, 20, 18, 21, 17, 15, 16, 22)
ns9() = Array(2, 1, 4, 1, 3, 3, 4, 1)
ns7() = Array(1, 3, 4, 1, 3, 2, 4, 1)
sd7() = Array(19, 1, 2, 3, 4, 5, 6, 7, 18, 9, 8, 10, 15, 16, 14, 13, 11, 12, 17)
sd9() = Array(15, 16, 17, 14, 13, 12, 11, 18, 10, 9, 8, 1, 2, 3, 4, 5, 7, 6, 19)
rd9() = Array(0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0)
rd7() = Array(1, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 1, 1, 0, 0, 0)
did = False
Select Case pn
    Case 7
        For i = 1 To 8
            to_drain(i) = td7(i)
            do_it(i) = False
            n_segs(i) = ns7(i)
        Next i
        For i = 1 To 19
            seg_data(i) = sd7(i)
            rev_data(i) = rd7(i)
        Next i
    Case 9
        For i = 1 To 8
            to_drain(i) = td9(i)
            do_it(i) = False
            n_segs(i) = ns9(i)
        Next i
        For i = 1 To 19
            seg_data(i) = sd9(i)
            rev_data(i) = rd9(i)
        Next i
End Select
If pipe(p1).full And pump(pn).pd(6) Then
    do_it(8) = True
    If vv(v1).opn And pipe(p2).full Then
        do_it(7) = True
        If vv(v2).opn And pipe(p3).full Then do_it(6) = True
        If vv(v3).opn And pipe(p4).full Then
            do_it(5) = True
            If vv(v4).opn And pipe(p5).full Then do_it(4) = True
            If vv(v5).opn And pipe(p6).full Then
                do_it(3) = True
                If vv(v6).opn And pipe(p7).full Then do_it(2) = True
                If vv(v7).opn And pipe(p8).full Then do_it(1) = True
            End If
        End If
    End If
    did = True
End If
j = 1
For c = 1 To 8
    ReDim wseg(n_segs(c))
    ReDim bseg(n_segs(c))
    For k = 1 To n_segs(c)
        wseg(k) = seg_data(j)
        bseg(k) = rev_data(j)
        j = j + 1
    Next k
    auv = to_drain(c)
    If do_it(c) Then Anim_Rev xlNone, rsuc, csuc, orisuc, lens, wseg, bseg, auv
Next c
If did Then ChangePump pn, pn
PumpAlarm pn
End Sub

Sub CleanSuc8_Anim()
Dim do_it(8) As Boolean, wseg(), bseg(), to_drain(), seg_data(), rev_data(), n_segs(), _
j%, k%, did As Boolean, c%, auv%
seg_data() = Array(1, 2, 3, 19, 4, 5, 6, 7, 15, 16, 17, 14, 13, 12, 11, 8, 10, 9, 18)
n_segs() = Array(3, 1, 4, 2, 1, 4, 3, 1)
to_drain() = Array(15, 22, 16, 19, 20, 18, 17, 21)
rev_data() = Array(0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 0, 0)
For i = 1 To 8
    do_it(i) = False
Next
did = False
If pipe(21).full And pump(8).pd(6) Then
        do_it(8) = True
        If vv(10).opn And pipe(17).full Then
            do_it(7) = True
            If vv(7).opn And pipe(18).full Then
                do_it(6) = True
                If vv(9).opn And pipe(20).full Then do_it(5) = True
                If vv(12).opn And pipe(19).full Then do_it(4) = True
            End If
            If vv(8).opn And pipe(16).full Then
                do_it(3) = True
                If vv(11).opn And pipe(22).full Then do_it(2) = True
                If vv(6).opn And pipe(15).full Then do_it(1) = True
            End If
        End If
        did = True
End If
j = 1
For c = 1 To 8
    ReDim wseg(n_segs(c))
    ReDim bseg(n_segs(c))
    For k = 1 To n_segs(c)
        wseg(k) = seg_data(j)
        bseg(k) = rev_data(j)
        j = j + 1
    Next k
    If do_it(c) Then
        auv = to_drain(c)
        Anim_Rev xlNone, rsuc, csuc, orisuc, lens, wseg, bseg, auv
    End If
Next
If did Then ChangePump 8, 3
PumpAlarm 8
End Sub

Sub ChangePump(pn%, cal%)
    If pump(pn).pd(1) And pump(pn).pd(5) And Not basin(1).lv(2) And Not pump(pn).pd(6) Then Exit Sub
    If pump(pn).pd(2) And pump(pn).pd(5) And Not basin(2).lv(2) And Not pump(pn).pd(6) Then Exit Sub
    pump(pn).pd(6) = Not pump(pn).pd(6)
    If pump(pn).pd(6) Then
        pump(pn).pd(8) = False
        PaintCells pump(pn).ind, Green, "main"
        pump(pn).la = "none"
    Else
        If pump(pn).pd(5) Then Range("bi47:bj47").Interior.ColorIndex = xlNone
        If pump(pn).la = "rec1" Or pump(pn).la = "trf2to1" Then FlowDisplay 1, False
        If pump(pn).la = "rec2" Or pump(pn).la = "trf1to2" Then FlowDisplay 2, False
        If pump(pn).la = "disch" Then FlowDisplay 3, False
        If cal <> 0 And (Not YF(pn)) Then Blinker W2(7), pn
        PaintCells pump(pn).ind, Red, "main"
    End If
    Application.Wait Now + TimeValue("0:00:01")
End Sub

Sub From_1_2(av%, mv%, mv2%, ms$, vi%, pi%, ms2$, bn%, ms3$, pn%)
    If (pump(pn).pd(1 + av) And (basin(1 + av).ba(1) > 0)) Then
        If pump(pn).pd(mv) Then
            If pump(pn).la = ("rec" & ms) And pump(pn).pd(6) And f_meter(1 + av) = True Then Exit Sub
            pump(pn).la = "rec" & ms
            f_meter(1 + av) = True
            If YF(pn) Then
                ChangePump pn, 0
                Exit Sub
            End If
            FlowDisplay 1 + av, True
            If Not basin(1 + av).lv(3) Then
                basin(1 + av).lv(3) = True
                WarnWin (warn(11) & Bw(7) & ms)
            End If
            Addition 1 + av
            Select Case pn
                Case 9
                    If bn = 2 Then          ' from basin 1
                        suc = 1
                        dis = 1
                    Else
                        suc = 2
                        If vv(18).opn And vv(19).opn Then
                            dis = 2
                        Else
                            dis = 3
                        End If
                    End If
                Case 7
                    If bn = 1 Then          ' from basin 2
                        suc = 4
                        dis = 6
                    Else
                        suc = 3
                        If vv(18).opn And vv(19).opn Then
                            dis = 4
                        Else
                            dis = 5
                        End If
                    End If
                Case 8
                    If bn = 2 Then
                        suc = 5
                        If vv(19).opn Then
                            dis = 7
                        Else
                            dis = 8
                        End If
                    Else
                        suc = 6
                        If vv(18).opn Then
                            dis = 9
                        Else
                            dis = 10
                        End If
                    End If
            End Select
            AnCore suc, dis
            Exit Sub
        End If
        If pump(pn).pd(mv2) Then
            basin(1 + av).lv(3) = False
            pump(pn).la = ms2                       ' transfer
            f_meter(bn) = True
            If YF(pn) Then
                If Range(FlowInd(bn)).Value = 0 Then noal(bn) = True
                                
                ChangePump pn, 0
                Exit Sub
            End If
            If basin(bn).ba(1) >= 95 Then
                WarnWin warn(1) & ms3 & warn(2)
                Blinker W2(7), pn
                ChangePump pn, 1 + av
                Exit Sub
            End If
            WarnWin warn(12) & Bw(7) & ms & warn(13) & Bw(7) & ms3
            TransferBasin 1 + av, bn, pn
            Exit Sub
        End If
       If pump(pn).pd(5) And basin(1 + av).ba(1) > 0 Then
            basin(1 + av).lv(3) = False
            If basin(1 + av).lv(2) Then                    'approved
                If (MsgBox(warn(14) & Bw(7) & ms & warn(15), 65, W2(6))) = 2 Then
                    If pump(pn).pd(6) Then ChangePump pn, 1 + av
                    Exit Sub
                Else
                    pump(pn).la = "disch"
                    f_meter(3) = True
                    If YF(pn) Then
                        ChangePump pn, 0
                        Exit Sub
                    End If
                    FlowDisplay 3, True
                    EmptyBasin 1 + av, pn
                End If
            Else
                ChangePump pn, 1 + av
            End If
        End If
    End If
End Sub

Sub BigPump(pn%, sp%, dp%)
Dim pin%
pump(pn).pd(7) = True
If pn = 7 Then pin = 2
If pn = 8 Then pin = 3
If pn = 9 Then pin = 1
If pump(pn).pd(5) Then
    If bp(pump(pn).pd(1), 1, pn) Then
        If pump(pn).la <> "disch" And pump(pn).la <> "none" Then PumpAlarm pn
        Exit Sub
    End If
    If bp(pump(pn).pd(2), 2, pn) Then
        If pump(pn).la <> "disch" And pump(pn).la <> "none" Then PumpAlarm pn
        Exit Sub
    End If
End If
If pump(pn).pd(6) Then
    If Not CheckDis(pn) Then
        WarnWin warn(5) & warn(17) & " - Sys0" & pin & "pump"       ' disch. misalignment
        Blinker W2(7), pn
        ChangePump pn, pin
        If pump(pn).la <> "disch" And pump(pn).la <> "none" Then PumpAlarm pn
        Exit Sub
    End If
    i = Prob(pn)
    If i <> 0 Then
        WarnWin warn(5) & warn(i) & " - Sys0" & pin & "pump"
        Blinker W2(7), pn
        ChangePump pn, pin
        Exit Sub
    End If
    If pump(pn).pd(1) And pump(pn).pd(2) Then                 ' suction misalignment
        WarnWin warn(5) & warn(16) & " - Sys0" & pin & "pump"
        Blinker W2(7), pn
        ChangePump pn, pin
        If pump(pn).la <> "disch" And pump(pn).la <> "none" Then PumpAlarm pn
        Exit Sub
    End If
    If pipe(sp).full Then
        rev() = Array(False)
        If dp = 23 Then segs() = Array(1)
        If dp = 24 Then segs() = Array(11)
        If dp = 25 Then segs() = Array(16)
        Anim_Rev Aqua, rdi, cdi, ordis, ldis, segs, rev, dp
    Else
        Application.Wait Now + TimeValue("0:00:02")         ' empty suction
        ChangePump pn, pin
        If pump(pn).la <> "disch" And pump(pn).la <> "none" Then PumpAlarm pn
        Exit Sub
    End If
    DisValve dp, pn
    If Not (pump(pn).pd(3) Or pump(pn).pd(4) Or pump(pn).pd(5)) Then
        ChangePump pn, pin                                  ' Discharge blocked
        If pump(pn).la <> "disch" And pump(pn).la <> "none" Then PumpAlarm pn
        Exit Sub
    Else
        If pump(pn).pd(1) Then From_1_2 0, 3, 4, "1", 7, 0, "trf1to2", 2, "2", pn
        If pump(pn).pd(2) Then From_1_2 1, 4, 3, "2", 8, 2, "trf2to1", 1, "1", pn
    End If
End If
Big2 pn
End Sub
    
Sub Big2(pn%)
Dim act_clean As Boolean
act_clean = True
If pump(pn).pd(1) And pump(pn).pd(3) Then act_clean = False
If pump(pn).pd(2) And pump(pn).pd(4) Then act_clean = False
If pump(pn).pd(1) And (basin(1).ba(1) > 0) Then act_clean = False
If pump(pn).pd(2) And (basin(2).ba(1) > 0) Then act_clean = False
If act_clean Then
    Select Case pn
        Case 7
            CleanS7_9 20, 18, 19, 17, 21, 16, 15, 22, 7, 9, 12, 7, 10, 8, 6, 11
        Case 8
            CleanSuc8_Anim
        Case 9
            CleanS7_9 22, 16, 15, 17, 21, 18, 20, 19, 9, 11, 6, 8, 10, 7, 9, 12
    End Select
Else
    If Not pump(pn).pd(6) Then
        If pump(pn).la <> "disch" And pump(pn).la <> "none" Then PumpAlarm pn
    End If
End If
End Sub
  • Like
Reactions: HowdyKeith, Dan_W, mykulpasskwa and 3 others
Author
Worf
Views
3,969
First release
Last update

Ratings

0.00 star(s) 0 ratings
Join the discussion

More Excel articles from Worf

Share this Excel article

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top