• If you would like to post, please check out the MrExcel Message Board FAQ and click here to register.
    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

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
Excel Version
2013
Author
Worf
Views
1,079
First release
Last update
Rating
0.00 star(s) 0 ratings

More Excel articles from Worf

Some videos you may like

This Week's Hot Topics

Top