Welcome to the electronic copies of the Macro's. This service is provided courtesy of Eric Patrick (X File) who maintains this site. The use of these Macro's is discussed in the April 1999 issue of Chemical Engineering Progress.
Hints to users: Select all the Macro's at once and copy them. Open up Excell and create a Macro. Paste this selection after the end Macro statement that Excel provides. Save the work and you should have the four Macro's discussed in the article. This hint works for Excel 97.
'
' Initialize Macro
' Macro version 1 written 5/16/97 by Roger Patrick
' asks for inputted MTBF info and duration info and adds level column
' to be used to input failure data into spreadsheet prior to running calculation macro
'
Sub Initialize()
Worksheets("Sheet1").Activate
' finds last column in tree
lc = Cells(1, 1).CurrentRegion.Columns(Cells(1, 1).CurrentRegion.Columns.Count).Column
'finds last row in tree
LR = Cells(1, 1).CurrentRegion.Rows(Cells(1, 1).CurrentRegion.Rows.Count).Row
' checks to see if header exists and skips if does
If Left(Cells(1, 1).Text, 5) = "Event" Then
GoTo oldtree
Else: Worksheets("sheet1").Rows(1).Insert
Worksheets("sheet1").Cells(1, 1).Value = "Event"
Worksheets("sheet1").Cells(1, lc + 3).Value = "level"
Worksheets("sheet1").Cells(1, lc + 4).Value = "MTBF in years"
Worksheets("sheet1").Columns(lc + 4).ColumnWidth = 14
Worksheets("Sheet1").Columns(lc + 4).NumberFormat = "#.##"
Worksheets("Sheet1").Columns(lc + 5).NumberFormat = "#.##"
Worksheets("sheet1").Cells(1, lc + 5).Value = "time to detect and repair in days"
LR = LR + 1
End If
oldtree:
' sets header window to keep from scrolling off screen
ActiveWindow.SplitRow = 1
' checks to see if mtbf column is in right place and adjusts columns to put in right place if not
' will only check for 10 columns past the last column of the tree
If Left(Worksheets("sheet1").Cells(1, lc + 4).Text, 4) <> "MTBF" Then 'if correct column skips correction
For n = 1 To (lc + 10)
If Left(Worksheets("sheet1").Cells(1, n).Text, 4) = "MTBF" Then
Range(Columns(n - 1), Columns(n + 1)).Cut (Cells(1, lc + 3)) 'moves MTBF and duration data to correct column
End If
Next n
b = "the failure data has been move to account for changes in levels"
MsgBox (b) ' writes message warning that columns have been moved
End If
' starts at most detailed events ctc is column counter
For ctc = lc To 2 Step -1
For ctr = 2 To LR Step 1 'row counter
If "" <> Left(Cells(ctr, ctc).Text, 1) Then 'looks for cell with events in tree
If IsEmpty(Worksheets("sheet1").Cells(ctr, lc + 4).Value) Then 'looks to see if MTBF data already exists
If "" = Left(Cells(ctr + 1, ctc + 1).Text, 1) Then 'looks to see if calculated MTBF or inputted
mtbf = Application.InputBox("what is the mean time between failures in years for " & Cells(ctr, ctc). Value, "MTBF ask", 15, 100, 100, Type:=1) 'this line is continued from the one before ask for MTBF info
dura = Application.InputBox("How many days will it take to detect and correct this failure ", "duration ask", 180, 100, 100, Type:=1) 'this is a continuation of the preceding line, ask for how long a failure will last
Worksheets("sheet1").Cells(ctr, lc + 4).Value = mtbf ' writes data to worksheet
Worksheets("sheet1").Cells(ctr, lc + 5).Value = dura ' writes data to worksheet
End If
End If
End If
Next
Next
' relooks at tree and puts level information on tree
For Each myobject In Cells(1, 1).CurrentRegion.Cells ' Iterate through each element.
If "" <> Left(myobject.Text, 1) Then
Worksheets("sheet1").Cells(myobject.Row, lc + 3).Value = myobject.Column
End If
Next myobject
Cells(1, 1).Select ' puts cursor on top event
End Sub
'
' Restore Macro
' Macro version 1 written 5/16/97 by Roger Patrick
' Macro puts all the rows back to height 13
'
Sub restore()
Cells(1, 1).CurrentRegion.Select
Selection.RowHeight = 13
Cells(1, 1).Select
End Sub
'
' viewer Macro
' Macro version 1 written 5/16/97 by Roger Patrick
' This macro allows you to select the columns (levels) and rows of the tree which you want to see
' it does this by setting row height on those you don't want to see to zero.
'
Sub viewer()
'STOPS SCREEN UPDATING UNTIL END OF SUBROUTINE
Worksheets("sheet1").Activate
Application.ScreenUpdating = False
'ASKS FOR INFO ABOUT ROWS AND LEVELS TO SEE
lctree = Cells(1, 1).CurrentRegion.Columns(Cells(1, 1).CurrentRegion.Columns.Count).Column ' last column
lrtree = Cells(1, 1).CurrentRegion.Rows(Cells(1, 1).CurrentRegion.Rows.Count).Row 'last row
ll = Application.InputBox("lowest level to see", "low level ask", 1, Type:=1)
hl = Application.InputBox("highest level to see", "high level ask", lctree, Type:=1)
LR = Application.InputBox("lowest row to see", "low row ask", 1, Type:=1)
hr = Application.InputBox("highest row to see", " high row ask", lrtree, Type:=1)
'RESETS ROW HEIGHT TO 13
Cells(1, 1).CurrentRegion.Select
Selection.RowHeight = 13
'MAKES ROWS NOT IN RANGE HAVE ROWHEIGHTS OF ZERO
For c = 2 To lrtree
If (c > hr Or c < LR) Then
Rows(c).RowHeight = 0
End If
Next c
'MAKES ROWS IN RANGE BUT NOT AT LEVELS HAVE ROW HEIGHT OF ZERO
For c = LR To hr
For cc = 1 To lctree
If "" <> Left(Cells(c, cc).Text, 1) Then
If (cc < ll Or cc > hl) Then
Rows(c).RowHeight = 0
End If
End If
Next cc
Next c
Cells(LR, 1).Select ' put cursor at top of range you wanted to view
End Sub
'
' calc Macro
' Macro version 1 written 5/16/97 by Roger Patrick
' This Macro will calculate the tree to determine top event MTBF
'
Sub calc()
Worksheets("sheet1").Activate
'determines last row number and last column number of tree
lctree = Cells(1, 1).CurrentRegion.Columns(Cells(1, 1).CurrentRegion.Columns.Count).Column ' last column
lrtree = Cells(1, 1).CurrentRegion.Rows(Cells(1, 1).CurrentRegion.Rows.Count).Row 'last row
'Calculates the tree using three loops and data in columns
'level (lctree+3), mtbf (lctree+4) and duration (lctree+5)
a = " screen will flicker as maco complete each column of calculations, updates screen after each column"
MsgBox (a)
For cc = (lctree) To 1 Step -1 ' COLUMN COUNTER STARTS AT LAST COLUMN AND WORKS TOWARDS FIRST COLUMN
Application.ScreenUpdating = False ' TURNS OFF SCREEN UPDATING
For cr = 3 To lrtree 'STARTS AT ROW 3 SINCE 1 IS HEADER AND 2 IS TOP EVENT
If Cells(cr, lctree + 3).Value = cc Then 'CHECKS LEVEL TO SEE IF LEVEL WORKING ON
a = 0
b = True
mtbf = Cells(cr + a, lctree + 4).Value
dura = Cells(cr + a, lctree + 5).Value
Do While b = True ' Inner Loop, B IS NEVER FALSE
lv = Cells(cr + a, lctree + 3).Value 'CHECK NEXT LOWER LEVEL TO SEE IF END OF EVENTS
If lv < cc Then
Exit Do
End If
If lv > cc Then 'CHECKS TO SEE IF NEXT LOWER LEVEL IS AT HIGHER LEVEL (MORE DETAILS)
GoTo endloop
End If
If a = 0 Then 'SKIPS CALCULATION SEQUENCE ON FIRST VALUE
GoTo endloop
End If
'DETERMINES AND/OR LOGIC OF TREE EVENT
If Left(Cells(cr + a, cc).Value, 1) = "o" Then ' If Text equals "or".
' calculations for or gates
mtbb = 1 / (1 / mtbf + 1 / Cells(cr + a, lctree + 4).Value)
durb = dura / mtbf + Cells(cr + a, lctree + 5).Value / Cells(cr + a, lctree + 4).Value
durb = durb / (1 / mtbf + 1 / Cells(cr + a, lctree + 4).Value)
GoTo calctype
End If
'calculations for and gates
mtbb = 1 / (365 * mtbf) * 1 / (365 * Cells(cr + a, lctree + 4).Value)
mtbb = (1 / (mtbb * (dura + Cells(cr + a, lctree + 5).Value))) / 365
durb = (dura * Cells(cr + a, lctree + 5).Value) / (dura + Cells(cr + a, lctree + 5).Value)
calctype:
mtbf = mtbb
dura = durb
endloop:
a = a + 1
Loop
Worksheets("sheet1").Cells(cr - 1, lctree + 4).Value = mtbf
Worksheets("sheet1").Cells(cr - 1, lctree + 5).Value = dura
cr = cr + a
End If
Next cr 'ROW COUNTER
Application.ScreenUpdating = True 'TURNS ON SCREEN UPDATING TO ADD COLUMN WORTH OF DATA
Next cc 'COLUMN (LEVEL) COUNTER
Cells(1, 1).Select
End Sub
