Greetings all,
I recently inherited a spreadsheet that takes around 25 seconds to run and after running one itteration it gets increasingly slower and starts using more and more memory.
As I am not the author of this project, I am not really sure where to begin in sorting out the code to ensure there is no memory loss and speed things up.
It would be great if someone could take a look over this and point out any major items that stand out.
It's really long...sorry
I recently inherited a spreadsheet that takes around 25 seconds to run and after running one itteration it gets increasingly slower and starts using more and more memory.
As I am not the author of this project, I am not really sure where to begin in sorting out the code to ensure there is no memory loss and speed things up.
It would be great if someone could take a look over this and point out any major items that stand out.
It's really long...sorry
Code:
Option Explicit
Public endProgram As Boolean
Public numCases As Integer
Public caseNames(50) As String
Public inputTypeFound
Public origwksht
Sub Update()
'****This sub routine updates the workbook
Dim sht As Worksheet
'Application.DisplayAlerts = False
'Save Current Sheet
Set origwksht = ActiveSheet
Application.Volatile
'Turn off screen updating and turn off calculations
Application.ScreenUpdating = False
Application.Calculation = xlManual
'initialize the endProgram variable to false
endProgram = False
'unprotect every sheet in the workbook
For Each sht In Sheets
sht.Unprotect
Next sht
'run the sub routines needed to update the program
Call casesAndInputs
'if the previous sub routine sets the endprogram variable to true, then the rest off the sub routine will be skipped
If endProgram <> True Then
Call generateTabsFromCaseNames
'if the previous sub routine sets the endprogram variable to true, then the rest off the sub routine will be skipped
If endProgram <> True Then
Call zeroBlueRowsOnCyclelinkTabs
Call performanceSummaryCases
Call unhideRowsOnPerfSummary
Call performanceSummaryCyclelinkValues
Call fuelCyclelinkValues
Call emissionsCases
Call emissionsCyclelinkValues
Call PFDCyclelinkValues
Call inputType
Call findMaxDuties
Call bypassDSHCyclelinkValues
Call pipeSizingCycleLinkValues
Call ammoniaComsumptionCyclelinkValues
Call LockCellIf
Call HideRowsOnPerfSummary
Call maxCOcatalystValue
Call hideArrowsOnPFD
Call dynamicAddCheckBoxesPerfSummary
End If
End If
'protect all the sheet in the workbook
For Each sht In Sheets
sht.Activate
Cells(1, 1).Activate
If ActiveSheet.Tab.ColorIndex <> 44 And ActiveSheet.Tab.ColorIndex <> 46 Then
sht.Protect
End If
Next sht
'return to the upper left corner of the original page
origwksht.Activate
'turn calculations back on
Application.Calculation = xlAutomatic
Application.DisplayAlerts = True
End Sub
Sub NextSheet()
If ActiveSheet.Index <> ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count).Index Then
ActiveSheet.Next.Activate
Else
ActiveWorkbook.Sheets(1).Activate
End If
End Sub
Sub prevSheet()
If ActiveSheet.Index <> ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count).Index Then
ActiveSheet.Previous.Activate
Else
ActiveWorkbook.Sheets(1).Activate
End If
End Sub
Sub casesAndInputs()
'**** This subroutine determines the number of cases and if the input is set to manual or cyclelink
Dim i As Integer, j As Integer, k As Integer, numrepeats As Integer, m As Integer, versionFound As Range
Dim category As String, wkshtName As String, formulaWkshtName(10) As String
Dim caseNameCell, Q As Integer
Dim caseFound(50) As Boolean, caseCell As Range
Dim sht As Worksheet
category = "Input Type"
'activate worksheet
Worksheets("General Inputs").Activate
'make a range to store the case names locations
Set caseNameCell = Range("A1")
'Find design caseName
With Worksheets("General Inputs").UsedRange
Set caseNameCell = .Find(What:="Design Case Name", After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
End With
'save the design case name to array
caseNames(0) = caseNameCell.Offset(0, 1).Value
'find the off design case names
With Worksheets("General Inputs").UsedRange
Set caseNameCell = .Find(What:="Off Design Case Names**", After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
End With
'initialize counter
Q = 0
'add off design case names to case name array until there are no more case names listed
Do While Len(caseNameCell.Offset(Q, 1).Value) <> 0 And caseNameCell.Offset(Q, 1).Value <> ""
'set casename array to off design case name value
caseNames(Q + 1) = caseNameCell.Offset(Q, 1).Value
'increase counter
Q = Q + 1
If Q >= 50 Then
MsgBox "Maximum number of cases exceeded"
endProgram = True
Exit Sub
End If
Loop
'counter is equal to number of cases
numCases = Q
'Initialize the input type found variable as a Range
Set inputTypeFound = Range("A1")
'Search for option selected by user
With Worksheets("General Inputs").UsedRange
'inputTypeFound is either Manual Input or gatecycle Input
Set inputTypeFound = .Find(What:=category, After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
End With
'check if there is a design case
If caseNames(0) = "" And inputTypeFound.Value <> "Manual Input" Then
MsgBox "Create a Design Case name and update again."
endProgram = True
Exit Sub
End If
'check for duplicate case names
For k = 0 To numCases
'set number of repeats to zero
numrepeats = 0
For m = 0 To numCases Step 1
'if two cases have the same name increase the counter
If caseNames(k) = caseNames(m) Then
numrepeats = numrepeats + 1
End If
Next m
'if there are repeats end the program and display a message
If numrepeats > 1 Then
MsgBox "Delete duplicate case name: " & caseNames(k) & " and update again."
endProgram = True
Exit Sub
End If
Next k
End Sub
Sub addNewCase()
Dim wkshtName As String, i As Integer, whatToCopy As Range, caseNameCell As Range, rowToCopyIndex As Integer
Dim whereToInsert As Range, savedCaseName As String
'turn off screen updating
Application.ScreenUpdating = False
'call this sub routine to get the current number of cases
Call casesAndInputs
'define the worksheet to be used
wkshtName = "General Inputs"
'Unprotect and activate worksheet
Worksheets(wkshtName).Unprotect
Worksheets(wkshtName).Activate
'make an array to store the cell locations
Set caseNameCell = Range("A1")
'find the off design case name cell
With Worksheets(wkshtName).UsedRange
Set caseNameCell = .Find(What:="Off Design Case Names**", After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
End With
'initialize counter
i = 0
'increase the counter for each yellow cell
Do While caseNameCell.Offset(i, 1).Interior.ColorIndex = 36
i = i + 1
Loop
'the cells to copy are in the row two before the end
rowToCopyIndex = i - 2
'using this worksheet
With Worksheets(wkshtName)
'set the range to copy only the grey and yellow under in the inputs box
Set whatToCopy = Range(caseNameCell.Offset(rowToCopyIndex, 0), caseNameCell.Offset(rowToCopyIndex, 1))
'copy those cells
whatToCopy.Copy
'set the range to insert those cells
Set whereToInsert = Range(caseNameCell.Offset(rowToCopyIndex + 1, 0), caseNameCell.Offset(rowToCopyIndex + 1, 0))
'insert the copied cells
whereToInsert.Insert shift:=xlDown
'rearrange the contents to original order
savedCaseName = whereToInsert.Offset(0, 1).Value
whereToInsert.Offset(0, 1).ClearContents
whereToInsert.Offset(-1, 1).Value = savedCaseName
End With
End Sub
Sub deleteCase()
Dim wkshtName As String, i As Integer, whatToDelete As Range, caseNameCell As Range, rowToDeleteIndex As Integer
Dim whereToSave As Range, savedCaseName As String
'turn off screen updating
Application.ScreenUpdating = False
'call this sub routine to get the current number of cases
Call casesAndInputs
'define the worksheet to be used
wkshtName = "General Inputs"
'Unprotect and activate worksheet
Worksheets(wkshtName).Unprotect
Worksheets(wkshtName).Activate
'make a range to store the cell locations
Set caseNameCell = Range("A1")
'find the off design case names cell
With Worksheets(wkshtName).UsedRange
Set caseNameCell = .Find(What:="Off Design Case Names**", After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
End With
'initialize counter
i = 0
'for each cell that is yellow increase the counter
Do While caseNameCell.Offset(i, 1).Interior.ColorIndex = 36
i = i + 1
Loop
'the row with cells to be deleted is two from the last row
'this is needed to preserve the formatting of the inputs box
'otherwise the last line would be deleted
rowToDeleteIndex = i - 2
'if the row isn't too close to the beginning
If rowToDeleteIndex > 1 Then
'using this worksheet
With Worksheets(wkshtName)
'save the case name in this cell
Set whereToSave = Range(caseNameCell.Offset(rowToDeleteIndex, 1), caseNameCell.Offset(rowToDeleteIndex, 1))
savedCaseName = whereToSave.Value
'delete this range and shift the cells up
Set whatToDelete = Range(caseNameCell.Offset(rowToDeleteIndex, 0), caseNameCell.Offset(rowToDeleteIndex, 1))
whatToDelete.Delete shift:=xlUp
'set the cell to put the case name, put the value in the cell
Set whereToSave = Range(caseNameCell.Offset(rowToDeleteIndex, 1), caseNameCell.Offset(rowToDeleteIndex, 1))
whereToSave.Value = savedCaseName
End With
End If
End Sub
Sub generateTabsFromCaseNames()
Dim wkshtName As String, i As Integer, a As Integer, b As Integer, caseFound As Boolean, designFound As Boolean
Dim sht As Worksheet, caseNameCell As Range, verCell As Range, verNum As String
'Turn off screen updating and turn off calculations
Application.ScreenUpdating = False
Application.Calculation = xlManual
Sheet36.Visible = True
Sheet35.Visible = True
'set the name of the sheet to be useed
wkshtName = "General Inputs"
'Activate Worksheet
Worksheets("General Inputs").Activate
If inputTypeFound.Value <> "Manual Input" Then
Set verCell = Range("a1")
designFound = False
For Each sht In Sheets
If sht.Tab.ColorIndex = 44 Or sht.Tab.ColorIndex = 46 Then
With Worksheets(sht.Name).UsedRange
Set verCell = .Find(What:="GC Version:", After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
End With
verNum = verCell.Value
If Left(verNum, 1) = Mid(inputTypeFound, 11, 1) Then
If sht.Tab.ColorIndex = 44 Then
designFound = True
End If
Else
Application.DisplayAlerts = False
If origwksht.Name = sht.Name Then
Set origwksht = Worksheets("General Inputs")
End If
Worksheets(sht.Name).Delete
Application.DisplayAlerts = True
End If
End If
Next sht
If designFound = False Then
On Error GoTo caseIDCellNotFound
ActiveWorkbook.Worksheets(inputTypeFound.Value).Copy before:=ActiveWorkbook.Sheets("General Inputs")
ActiveSheet.Tab.ColorIndex = 44
End If
'delete case tabs not used for all cases but the design case
For Each sht In Sheets
'sets case to not found initially
caseFound = False
'for the number of cases that exist excluding the design case
For a = numCases To 1 Step -1
'check if the sheet name is an existing case
If caseNames(a) = sht.Name Then
'if it one of the cases in the case name array set casefound to true so it will not be deleted
caseFound = True
End If
Next a
'if the cell didnt match any cases and it is orange, delete its sheet
If caseFound = False And sht.Tab.ColorIndex = 46 Then
'delete sheet if the case wasnt found
Application.DisplayAlerts = False
If origwksht.Name = sht.Name Then
Set origwksht = Worksheets("General Inputs")
End If
Worksheets(sht.Name).Delete
Application.DisplayAlerts = True
End If
Next sht
'Rename the design case sheet
For Each sht In Sheets
'if the sheet is light orange
If sht.Tab.ColorIndex = 44 Then
'name the sheet the design case name
sht.Name = caseNames(0)
'find the case id cell
With Worksheets(caseNames(0)).UsedRange
On Error GoTo caseIDCellNotFound
Set caseNameCell = .Find(What:="Case ID:", After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
End With
'set the case id cell to the design case name
caseNameCell.Value = caseNames(0)
'set the model id cell to the design case name as well
caseNameCell.Offset(-1, 0).Value = caseNames(0)
End If
Next sht
'add sheet for each case number that doesnt already exist
'for the number of cases that exist - 1, skipping the design case
For a = 1 To numCases Step 1
'sets case no not found initially
caseFound = False
'for the number of cases that exist
For Each sht In Sheets
'check if the case needs to added or already exists
If caseNames(a) = sht.Name Then
caseFound = True
Exit For
End If
Next sht
'if the case wasnt found, add it
If caseFound = False Then
'copy the design case sheet
On Error GoTo caseIDCellNotFound
ActiveWorkbook.Worksheets(caseNames(0)).Copy before:=ActiveWorkbook.Sheets(caseNames(0))
'set the name and set the color to orange
ActiveSheet.Name = caseNames(a)
ActiveSheet.Tab.ColorIndex = 46
'set a location for the case id cell
Set caseNameCell = Range("A1")
'find the case id cell on this worksheet
With ActiveWorkbook.Worksheets(caseNames(a)).UsedRange
On Error GoTo caseIDCellNotFound
Set caseNameCell = .Find(What:="Case ID:", After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
End With
'set the case id cell to the casename
caseNameCell.Value = ActiveWorkbook.Worksheets(caseNames(a)).Name
'set the model id cell to the design case name
'REMOVED BECAUSE DESIGN CASE ISN'T NECESSARILY MODEL ID NAME - TL 1/9/2012
'caseNameCell.Offset(-1, 0).Value = ActiveWorkbook.Worksheets(caseNames(0)).Name
End If
Next a
Else
Application.DisplayAlerts = False
'delete case tabs not used for all cases but the design case
For Each sht In Sheets
'if the cell didnt match any cases and it is light orange or orange, delete its sheet
If sht.Tab.ColorIndex = 44 Or sht.Tab.ColorIndex = 46 Then
'delete sheet if the case wasnt found
If origwksht.Name = sht.Name Then
Set origwksht = Worksheets("General Inputs")
End If
Worksheets(sht.Name).Delete
End If
Next sht
Application.DisplayAlerts = True
End If
Sheet36.Visible = False
Sheet35.Visible = False
'calculate the cells
Application.Calculation = xlAutomatic
Application.Calculation = xlManual
Exit Sub
'when to many cases are added (worksheets are copied) at once it can overload excel
caseIDCellNotFound:
MsgBox "Insufficient memory - Save & Close file and try adding fewer cases."
endProgram = True
Exit Sub
End Sub
Sub zeroBlueRowsOnCyclelinkTabs()
Dim sht As Worksheet, a As Integer, findCell As Range
'for every sheet in the workbook
For Each sht In Sheets
'if the sheet tab is colored light orange, orange or red
If sht.Tab.ColorIndex = 46 Or sht.Tab.ColorIndex = 44 Or sht.Tab.ColorIndex = 9 Then
'initialize range to store location
Set findCell = Range("A1")
'on this sheet find gatecycle outputs
With sht.UsedRange
Set findCell = .Find(What:="GateCycle Outputs", After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
End With
'until the end of the outputs is reached set all rows that have the turquoise color to zero
a = 0
Do While findCell.Offset(a, 0).Value <> "End Outputs"
a = a + 1
If findCell.Offset(a, 0).Interior.ColorIndex = 8 Then
findCell.Offset(a, 4).Value = 0
End If
Loop
End If
Next sht
End Sub
Sub loadCyclelink6()
Dim findCell As Range
Dim i As Integer
Set findCell = Range("A1")
'shortcut keys to load cyclelink data, given that cyclelink is turned on
ActiveSheet.Unprotect
With ActiveSheet.UsedRange
Set findCell = .Find(What:="Link Area ID:", After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
End With
findCell.Select
SendKeys "+^L", True
' Application.Wait Now + TimeValue("00:00:03")
'For i = 1 To 13
' SendKeys "~"
' i = i + 1
'Next i
'SendKeys "{c}"
'SendKeys "{l}"
End Sub
Sub loadCyclelink5()
Dim findCell As Range
Set findCell = Range("A1")
'shortcut keys to load cyclelink data, given that cyclelink is turned on
ActiveSheet.Unprotect
With ActiveSheet.UsedRange
Set findCell = .Find(What:="Link Area ID:", After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
End With
findCell.Select
SendKeys "{f10}"
SendKeys "{c}"
SendKeys "{r}"
End Sub
Sub emissionsCases()
Dim i As Integer, j As Integer, k As Integer, caseNameCell, caseFound As Boolean, numCurEmissionsCases As Integer
Dim a As Integer, formulaWkshtName(10) As String, wkshtName As String, caseCell As Range, b As Integer, whatToSet(10, 50)
'set the worksheet name that will be used
formulaWkshtName(0) = "Emissions Calculation"
whatToSet(0, 0) = "CASE NAME"
'activate the worksheet
Worksheets(formulaWkshtName(0)).Activate
'Initialize cell where case names are located
Set caseCell = Range("A1")
'Find cell that is in the row with the "CASE NAME" label
With Worksheets(formulaWkshtName(0)).UsedRange
On Error GoTo NotFound
'offset the cell by two columns to get the first cases cell with its name
Set caseCell = .Find(What:=whatToSet(0, 0), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'Determine the number of cases that already exist on the page
'initialize number of cases currently shown to 0
numCurEmissionsCases = 0
'if the cell contains something or is light green the row will be counted, continues until both condition aren't met
Do While caseCell.Offset(0, numCurEmissionsCases).Value <> "" Or caseCell.Offset(0, numCurEmissionsCases).Interior.ColorIndex = 35
numCurEmissionsCases = numCurEmissionsCases + 1
Loop
On Error GoTo CaseOrder
'when the column contains a case name that doesnt exist in caseNames, delete that column
'for the number of cases shown on the emission calculation, not including the design case which is never deleted
For a = numCurEmissionsCases - 1 To 1 Step -1
'sets case no not found initially
caseFound = False
'for the number of cases that exist
For b = 1 To numCases
'check if the cell is an existing case
If caseCell.Offset(0, a).Value = caseNames(b) Then
'if it one of the cases in the case name array set casefound to true so it will not be deleted
caseFound = True
End If
Next b
'if the cell didnt match any cases, delete its column
If caseFound = False Then
'delete column if the case wasnt found
Worksheets(formulaWkshtName(0)).Columns(caseCell.Column + a).Delete
End If
Next a
'set the name of the first column to the design case name
caseCell.Offset(0, 0).Value = caseNames(0)
'add columns for each case number that doesnt already exist
'for the number of cases that exist - 1, skipping the design case in the first column
For a = 1 To numCases Step 1
'sets case no not found initially
caseFound = False
'for the number of cases that exist
For b = 0 To numCases
'check if the case needs to added or already exist
If caseNames(a) = caseCell.Offset(0, b).Value Then
caseFound = True
End If
Next b
'if the case wasnt found, add it
If caseFound = False Then
'with the emissions calculation worksheet
With Worksheets(formulaWkshtName(0))
'copy the design case
.Columns(caseCell.Column).Copy
'insert the design case
.Columns(caseCell.Column + a).Insert
'rename the new column to this cases name
caseCell.Offset(0, a).Value = caseNames(a)
End With
End If
Next a
'reorder columns
'for the number of cases
'iterate this procedure three times
For i = 0 To 2 Step 1
'for every case
For a = 0 To numCases Step 1
'for the number of cases
For b = 0 To numCases
'check if the case needs to be reorder or if it is in the right location
If caseCell.Offset(0, a).Value = caseNames(b) Then
'reorder cases that are in the wrong location
If a <> b Then
'with the emissions calc
With Worksheets(formulaWkshtName(0))
'cut this case
.Columns(caseCell.Column + a).Cut
'put it in the order it belongs
.Columns(caseCell.Column + b).Insert
End With
End If
End If
Next b
Next a
Next i
Exit Sub
NotFound:
MsgBox whatToSet(i, j)
Resume Next
CaseOrder:
MsgBox "Problem with a= " & a & " and b= " & b
Resume Next
End Sub
Sub performanceSummaryCases()
Dim i As Integer, j As Integer, k As Integer, caseNameCell, caseFound As Boolean, numCurPerfSumCases As Integer
Dim a As Integer, formulaWkshtName(10) As String, wkshtName As String, caseCell As Range, b As Integer, whatToSet(10, 50)
'define the worksheet to work with
formulaWkshtName(0) = "Perf. Summary"
'define what needs to be found
whatToSet(0, 0) = "Case Name"
'activate this sheet
Worksheets(formulaWkshtName(0)).Activate
'Initialize cell where case names are located
Set caseCell = Range("A1")
'Find cell that is in the row with the "Case Name" label
With Worksheets(formulaWkshtName(0)).UsedRange
On Error GoTo NotFound
'offset the cell by two columns to get the first cases cell with its name
Set caseCell = .Find(What:=whatToSet(0, 0), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'Determine the number of cases that already exist on the page
'initialize number of cases currently shown to 0
numCurPerfSumCases = 0
'if the cell contains something or is light green the row will be counted, continues until both condition aren't met
Do While caseCell.Offset(0, numCurPerfSumCases).Value <> "" Or caseCell.Offset(0, numCurPerfSumCases).Interior.ColorIndex = 35
numCurPerfSumCases = numCurPerfSumCases + 1
Loop
On Error GoTo CaseOrder
'when the column contains a case name that doesnt exist in caseNames, delete that column
'for the number of cases shown on the perf sum. calculation, not including the design case which is never deleted
For a = numCurPerfSumCases - 1 To 1 Step -1
'sets case to not found initially
caseFound = False
'for the number of cases that exist
For b = 1 To numCases
'check if the cell is an existing case
If caseCell.Offset(0, a).Value = caseNames(b) Then
'if it one of the cases in the case name array set casefound to true so it will not be deleted
caseFound = True
End If
Next b
'if the cell didnt match any cases, delete its column
If caseFound = False Then
'delete column if the case wasnt found
Worksheets(formulaWkshtName(0)).Columns(caseCell.Column + a).Delete
End If
Next a
'set the first column to the design case name
caseCell.Offset(0, 0).Value = caseNames(0)
'add columns for each case number that doesnt already exist
'for the number of cases that exist - 1, skipping the design case in the first column
For a = 1 To numCases Step 1
'sets case no not found initially
caseFound = False
'for the number of cases that exist
For b = 0 To numCases
'check if the case needs to added or already exist
If caseNames(a) = caseCell.Offset(0, b).Value Then
caseFound = True
End If
Next b
'if the case wasnt found, add it
If caseFound = False Then
'with the emissions calculation worksheet
With Worksheets(formulaWkshtName(0))
'copy the design case
.Columns(caseCell.Column).Copy
'insert the design case
.Columns(caseCell.Column + a).Insert
'set the name of the column to this case name
caseCell.Offset(0, a).Value = caseNames(a)
End With
End If
Next a
'reorder columns
'run this procedure three times
For i = 0 To 2 Step 1
'for the number of cases
For a = 0 To numCases Step 1
'for the number of cases
For b = 0 To numCases
'check if the case needs to be reorder or if it is in the right location
If caseCell.Offset(0, a).Value = caseNames(b) Then
'reorder cases that are in the wrong location
If a <> b Then
'with the this worksheet
With Worksheets(formulaWkshtName(0))
'cut this case
.Columns(caseCell.Column + a).Cut
'put it in the order it belongs
.Columns(caseCell.Column + b).Insert
End With
End If
End If
Next b
Next a
Next i
Exit Sub
NotFound:
MsgBox whatToSet(i, j)
Resume Next
CaseOrder:
MsgBox "Problem with a= " & a & " and b= " & b
Resume Next
End Sub
Sub fuelCyclelinkValues()
Dim i As Integer, j As Integer, k As Integer, whatToSet(10, 50) As String, a As Integer
Dim category(0) As String, wkshtName As String, formulaWkshtName(10) As String, formulaCell As Range
Dim targetCellLocation(10, 50, 50), linkValue(0, 50, 50), calculationMethod As Range
Dim lCount As Long, numrepeats As Integer, n As Integer, P As Integer, m As Integer, targetValue(10, 50, 50)
'worksheet defined
wkshtName = "FuelGas"
'categories that need to found
category(0) = "Calculation Method"
'worksheet with the cells to be modified defined
formulaWkshtName(0) = "FuelGas"
'Definitions of categories to be modified
whatToSet(0, 0) = "METHANE"
whatToSet(0, 1) = "ETHANE"
whatToSet(0, 2) = "PROPANE"
whatToSet(0, 3) = "ISOBUTANE"
whatToSet(0, 4) = "N-BUTANE"
whatToSet(0, 5) = "ISOPENTANE"
whatToSet(0, 6) = "N-PENTANE"
whatToSet(0, 7) = "HEXANE"
whatToSet(0, 8) = "HEPTANE"
whatToSet(0, 9) = "OCTANE"
whatToSet(0, 10) = "NONANE"
whatToSet(0, 11) = "N-DECANE"
whatToSet(0, 12) = "BENZENE"
whatToSet(0, 13) = "TOLUENE"
whatToSet(0, 14) = "CARBON DIOXIDE "
whatToSet(0, 15) = "CARBON MONOXIDE"
whatToSet(0, 16) = "NITROGEN "
whatToSet(0, 17) = "HYDROGEN "
whatToSet(0, 18) = "HYDROGEN SULFIDE"
whatToSet(0, 19) = "SULFUR"
whatToSet(0, 20) = "ARGON "
whatToSet(0, 21) = "WATER VAPOR"
whatToSet(0, 22) = "OXYGEN "
whatToSet(0, 23) = "NG Heating Value"
whatToSet(0, 24) = "HHV/LHV"
whatToSet(0, 25) = "HHV/LHV Ratio"
'activate the sheet
Worksheets(wkshtName).Activate
' SET VALUES TO CELLS
'Initialize locations
Set formulaCell = Range("A1")
Set calculationMethod = Range("A1")
'using this worksheet
With Worksheets(wkshtName).UsedRange
'find the calculation method; volume basis, mass basis, or direct input
Set calculationMethod = .Find(What:=category(0), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
End With
'loops through each worksheet with cells need to be set on
For i = 0 To 10 Step 1
'activate worksheet
Worksheets(formulaWkshtName(i)).Activate
'Loops through all the categories that need to be set (whatToSet)
For j = 0 To 50 Step 1
'Search for label to set and offsets 2
With Worksheets(formulaWkshtName(i)).UsedRange
'sets cell as cell to be modified
On Error GoTo NotFound
Set formulaCell = .Find(What:=whatToSet(i, j), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
formulaCell.Select
'Repeats actions for adjacent cells for the number of cases (this sub routine was modified from a previously
'written, which had this additional "k" loop which really isnt needed in the sub routine)
For k = 0 To 0 Step 1
If inputTypeFound.Value <> "Manual Input" Then
'Select Cell to be modified on the fuel gas calculation
'Find number of times whattoset is repeated in cyclink
numrepeats = WorksheetFunction.CountIf(Worksheets(caseNames(k)).UsedRange, whatToSet(i, j))
'target cell is the cell that needs to be found on the cyclelink tab
'offset it by one cell to the left to get that whatToSet value for the fuel gas calc
'the target cell location is initialized
Set targetCellLocation(i, j, k) = Range("A1")
'Go To worksheet with that case name (the design case)
With Worksheets(caseNames(k)).UsedRange
For lCount = 1 To numrepeats Step 1
'find the what to set value on the cyclink tab for that case and
'save the location to targetcelllocation
On Error GoTo NotFound
Set targetCellLocation(i, j, k) = .Find(What:=whatToSet(i, j), After:=targetCellLocation(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some whatToSet values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
If targetCellLocation(i, j, k).Offset(0, -5).Interior.ColorIndex <> 8 Then
'if volume basis is selected take the value on the cyclelink page offset one down and one to the left
If calculationMethod.Value = "Volume Basis" Then
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(1, -1).Value
'if mass basis is selected take the value on the cyclelink page offset one to the left
ElseIf calculationMethod.Value = "Mass Basis" Then
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(0, -1).Value
'if volume basis is selected take the value on the cyclelink page offset one to the left
ElseIf calculationMethod.Value = "Direct Input" Then
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(0, -1).Value
End If
'exits the lcount if the proper cell was found
Exit For
End If
Next lCount
End With
End If
'if the cyclelink input is used
If inputTypeFound.Value <> "Manual Input" Then
'if mass or volume basis was selected
If calculationMethod.Value = "Mass Basis" Or calculationMethod.Value = "Volume Basis" Then
'Sets the target value to the proper cell
Selection.Value = targetValue(i, j, k)
'set to green, lock the cell, and set the font to black
Selection.Interior.ColorIndex = 35
Selection.Locked = True
Selection.Font.ColorIndex = 1
'if direct input was selected
ElseIf calculationMethod.Value = "Direct Input" Then
'only set these values when it is direct input
If whatToSet(i, j) = "NG Heating Value" Or whatToSet(i, j) = "HHV/LHV" Or whatToSet(i, j) = "HHV/LHV Ratio" Then
Selection.Value = targetValue(i, j, k)
'set to green, lock the cell, and set the font to black
Selection.Interior.ColorIndex = 35
Selection.Locked = True
Selection.Font.ColorIndex = 1
End If
End If
'if the manual input is used
ElseIf inputTypeFound.Value = "Manual Input" Then
'if mass or volume basis was selected
If calculationMethod.Value = "Mass Basis" Or calculationMethod.Value = "Volume Basis" Then
If Selection.Interior.ColorIndex = 35 Then
If whatToSet(i, j) = "METHANE" And Selection.Offset(22, 0).Value = 0 Then
Selection.Value = 1
Else
Selection.Value = 0
End If
End If
'set to yellow, unlocked, black font
Selection.Interior.ColorIndex = 36
Selection.Locked = False
Selection.Font.ColorIndex = 1
'if direct input was selected
ElseIf calculationMethod.Value = "Direct Input" Then
'only set these cells to zero when it is direct input
If whatToSet(i, j) = "NG Heating Value" Or whatToSet(i, j) = "HHV/LHV Ratio" Then
'only set to zero when it was green previously
If Selection.Interior.ColorIndex = 35 Then
Selection.Value = 0
End If
'set to yellow, unlocked, black font
Selection.Interior.ColorIndex = 36
Selection.Locked = False
Selection.Font.ColorIndex = 1
'only set this cell to zero when it is direct input
ElseIf whatToSet(i, j) = "HHV/LHV" Then
'only set to zero when it was green previously
If Selection.Interior.ColorIndex = 35 Then
Selection.Value = 0
End If
'set to yellow, unlocked, black font
Selection.Interior.ColorIndex = 36
Selection.Locked = False
Selection.Font.ColorIndex = 1
End If
End If
End If
Next k
'If there are no more cells to lock/unlock, end loop
If whatToSet(i, j + 1) = "" Then
Exit For
End If
Next j
'If there are no more worksheets to set cells on, end loop
If formulaWkshtName(i + 1) = "" Then
Exit For
End If
Next i
Exit Sub
NotFound:
MsgBox whatToSet(i, j)
Resume Next
End Sub
Sub emissionsCyclelinkValues()
Dim i As Integer, j As Integer, k As Integer, whatToSet(10, 50) As String, n As Integer, lCount As Long
Dim formulaWkshtName(10) As String, formulaCell As Range, m As Integer, numrepeats As Integer
Dim targetCellLocation(10, 50, 50), linkValue(0, 50, 50), targetValue(10, 50, 50), P As Integer
'worksheet where values for categories below will be written to
formulaWkshtName(0) = "Emissions Calculation"
'Definitions of categories to be read in from cyclelink to the emissions calculations
whatToSet(0, 0) = "CTG Exhaust Enthalpy"
whatToSet(0, 1) = "Ambient Pressure "
whatToSet(0, 2) = "CTG Outlet Back Pressure (Max)"
whatToSet(0, 3) = "CTG Air Flow"
whatToSet(0, 4) = "Stack Exhaust Enthalpy"
whatToSet(0, 5) = "Stack Flow Rate"
whatToSet(0, 6) = "ARGON "
whatToSet(0, 7) = "NITROGEN "
whatToSet(0, 8) = "OXYGEN "
whatToSet(0, 9) = "CARBON DIOXIDE "
whatToSet(0, 10) = "WATER "
whatToSet(0, 11) = "ARGON "
whatToSet(0, 12) = "NITROGEN "
whatToSet(0, 13) = "OXYGEN "
whatToSet(0, 14) = "CARBON DIOXIDE "
whatToSet(0, 15) = "WATER "
whatToSet(0, 16) = "Gas Turbines Running"
whatToSet(0, 17) = "Total Plant Gross Output"
whatToSet(0, 18) = "Net Plant Output"
whatToSet(0, 19) = "Total CTG Gross Output"
whatToSet(0, 20) = "CTG Fuel Flow (each)"
whatToSet(0, 21) = "Duct Burner Fuel Flow (each)"
whatToSet(0, 22) = "CTG Exhaust Flow "
whatToSet(0, 23) = "Stack Exit Temperature"
'SET VALUES TO CELLS
'Initialize location
Set formulaCell = Range("A1")
'loops through each worksheet cells need to be set on
For i = 0 To 10 Step 1
'activate worksheet
Worksheets(formulaWkshtName(i)).Activate
'Loops through all the categories that need to be set (whatToSet)
For j = 0 To 50 Step 1
'Search for label to set and offsets 2
With Worksheets(formulaWkshtName(i)).UsedRange
'sets cell as cell to be modified
On Error GoTo NotFound
Set formulaCell = .Find(What:=whatToSet(i, j), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'Repeats actions for adjacent cells for the number of cases
For k = 0 To numCases Step 1
'Select Cell to be modified on the emissions calculation
'and offset from the design case for each additinnal case
formulaCell.Offset(0, k).Select
'Check if the input type for manual input or gatecycle input
If inputTypeFound = "Manual Input" Then
'For each case
'sets cell to zero if they aren't yellow
'Prevents manual inputs from being overwritten
If Selection.Interior.ColorIndex <> 36 Then
Selection.Value = 0
'set to yellow, unlocks and black font
Selection.Interior.ColorIndex = 36
Selection.Locked = False
Selection.Font.ColorIndex = 1
End If
'if the input type is gatecycle input
ElseIf inputTypeFound = "GateCycle 6.0" Or inputTypeFound = "GateCycle 5.61" Then
'Find number of times whattoset is repeated in a cyclelink tab
numrepeats = WorksheetFunction.CountIf(Worksheets(caseNames(k)).UsedRange, whatToSet(i, j))
'target cell is the cell that needs to be found on the cyclelink tab
'offset it by one cell to the left to get that whatToSet value for the emissions calc
'the target cell location is initialized
Set targetCellLocation(i, j, k) = Range("A1")
'Go To worksheet with that case name
With Worksheets(caseNames(k)).UsedRange
For lCount = 1 To numrepeats Step 1
'find the what to set value on the cyclink tab for that case and
'save the location to targetcelllocation
On Error GoTo NotFound
Set targetCellLocation(i, j, k) = .Find(What:=whatToSet(i, j), After:=targetCellLocation(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some whatToSet values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
If targetCellLocation(i, j, k).Offset(0, -5).Interior.ColorIndex <> 8 Then
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(0, -1).Value
Exit For
End If
Next lCount
End With
'Sets the target value to the proper cell
Selection.Value = targetValue(i, j, k)
'set to green, locks it, and black font
Selection.Interior.ColorIndex = 35
Selection.Locked = True
Selection.Font.ColorIndex = 1
End If
Next k
'If there are no more cells to lock/unlock, end loop
If whatToSet(i, j + 1) = "" Then
Exit For
End If
Next j
'If there are no more worksheets to set cells on, end loop
If formulaWkshtName(i + 1) = "" Then
Exit For
End If
Next i
Exit Sub
NotFound:
MsgBox whatToSet(i, j)
Resume Next
End Sub
Sub performanceSummaryCyclelinkValues()
Dim i As Integer, j As Integer, k As Integer, targetValue(10, 80, 80)
Dim formulaWkshtName(10) As String, formulaCell As Range, targetCellLocation(10, 80, 80), linkValue(0, 80, 80)
Dim whatToSet(10, 80) As String, lCount As Long, numrepeats As Integer, n As Integer, P As Integer, m As Integer
'worksheet where values for categories below will be written to
formulaWkshtName(0) = "Perf. Summary"
'Definitions of categories to be read in from cyclelink to the perf summary calculation
whatToSet(0, 0) = "Site Elevation"
whatToSet(0, 1) = "Ambient Dry Bulb Temperature"
whatToSet(0, 2) = "Ambient Relative Humidity "
whatToSet(0, 3) = "Ambient Wet Bulb Temperature"
whatToSet(0, 4) = "Inlet Cooling"
whatToSet(0, 5) = "Supplementary Firing (SF)"
whatToSet(0, 6) = "Gas Turbines Running"
whatToSet(0, 7) = "CTG Exhaust Flow"
whatToSet(0, 8) = "CTG Exhaust Temperature"
whatToSet(0, 9) = "CTG Exhaust Loss"
whatToSet(0, 10) = "DB Outlet temperature"
whatToSet(0, 11) = "Stack Exit Temperature"
whatToSet(0, 12) = "STG Throttle Pressure"
whatToSet(0, 13) = "Main Steam Throttle Flow"
whatToSet(0, 14) = "Main Steam Throttle Temperature"
whatToSet(0, 15) = "Hot Reheat Throttle Temperature"
whatToSet(0, 16) = "Hot Reheat Steam Throttle Flow"
whatToSet(0, 17) = "LP Turbine Steam Flow"
whatToSet(0, 18) = "HP Pinch"
whatToSet(0, 19) = "IP Pinch"
whatToSet(0, 20) = "LP Pinch"
whatToSet(0, 21) = "Main Steam Piping pressure drop"
whatToSet(0, 22) = "Hot Reheat Piping pressure drop"
whatToSet(0, 23) = "STG Exhaust Flow"
whatToSet(0, 24) = "STG Exhaust Moisture"
whatToSet(0, 25) = "STG Exhaust Loss"
whatToSet(0, 26) = "Condenser Back Pressure"
whatToSet(0, 27) = "Condenser Duty"
whatToSet(0, 28) = "Cooling Tower Range"
whatToSet(0, 29) = "Condenser TTD"
whatToSet(0, 30) = "Approach Temperature"
whatToSet(0, 31) = "CW Temp at Inlet to Condenser"
whatToSet(0, 32) = "CW Flow Rate"
whatToSet(0, 33) = "Gross Output per CTG"
whatToSet(0, 34) = "Gross Output per STG"
whatToSet(0, 35) = "CTG Fuel Flow (each)"
whatToSet(0, 36) = "Duct Burner Fuel Flow (each)"
whatToSet(0, 37) = "Main Steam Piping pressure drop" 'is this a duplicate?
whatToSet(0, 38) = "Hot Reheat Piping pressure drop" ' is this a duplicate?
whatToSet(0, 39) = "Cycle Makeup Water"
whatToSet(0, 40) = "Inlet Cooling Water Consumption"
whatToSet(0, 41) = "Cooling Tower Evaporation Loss"
whatToSet(0, 42) = "Cooling Tower Blowdown(2)"
whatToSet(0, 43) = "CTG Steam/Water Injection"
whatToSet(0, 44) = "Steam Turbines Running"
whatToSet(0, 45) = "Total STG Gross Output"
whatToSet(0, 46) = "HP / HRH Throttle Temperature"
whatToSet(0, 47) = "HP / IP / LP Pinch"
whatToSet(0, 48) = "HP / LP Pinch"
whatToSet(0, 49) = "Cold Reheat Steam Flow"
whatToSet(0, 50) = "HP / IP / LP Steam Turbine Overall Efficiencies"
whatToSet(0, 51) = "Cold Reheat Piping pressure drop"
whatToSet(0, 52) = "CTG Net Heat Rate"
whatToSet(0, 53) = "LP Steam Flow"
whatToSet(0, 54) = "HP Steam Flow"
whatToSet(0, 55) = "HRH Steam Flow"
whatToSet(0, 56) = "IP Steam Flow"
whatToSet(0, 57) = "IP Steam Conditions"
whatToSet(0, 58) = "HRH Steam Conditions"
whatToSet(0, 59) = "LP Steam Conditions"
whatToSet(0, 60) = "HP Steam Conditions"
whatToSet(0, 61) = "CRH Steam Flow"
whatToSet(0, 62) = "CRH Steam Temperature"
whatToSet(0, 63) = "LP Economizer FW Temp (Before Recirc)"
whatToSet(0, 64) = "LP Economizer FW Temp (After Recirc)"
whatToSet(0, 65) = "Hot Reheat Throttle Pressure"
whatToSet(0, 66) = "CRH Temperature at STG"
whatToSet(0, 67) = "CRH Pressure at STG"
whatToSet(0, 68) = "LP Turbine Steam Temperature"
whatToSet(0, 69) = "STG Exhaust Temperature"
whatToSet(0, 70) = "STG Exhaust Pressure"
whatToSet(0, 71) = "LP Admission Steam Temperature"
whatToSet(0, 72) = "LP Admission Steam Flow"
whatToSet(0, 73) = "LP Admission Steam Pressure"
whatToSet(0, 74) = "STG Exhaust Enthalpy"
whatToSet(0, 75) = "Argon "
whatToSet(0, 76) = "Nitrogen "
whatToSet(0, 77) = "Oxygen "
whatToSet(0, 78) = "Carbon Dioxide "
whatToSet(0, 79) = "Water "
' SET VALUES TO CELLS
'Initialize Value
Set formulaCell = Range("A1")
'loops through each worksheet cells need to be set on
For i = 0 To 10 Step 1
'unprotect and activate worksheet
Worksheets(formulaWkshtName(i)).Activate
Worksheets(formulaWkshtName(i)).Unprotect
'Loops through all the categories that need to be set (whatToSet)
For j = 0 To 80 Step 1
'Search for label to set and offsets 2
With Worksheets(formulaWkshtName(i)).UsedRange
'sets cell as cell to be modified
On Error GoTo NotFound
Set formulaCell = .Find(What:=whatToSet(i, j), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'Repeats actions for adjacent cells for the number of cases
For k = 0 To numCases Step 1
'Select Cell to be modified on the perf summary calculation
'and offset from the design case for each additinnal case
formulaCell.Offset(0, k).Select
'Check if the input type for manual input or gatecycle input
If inputTypeFound = "Manual Input" Then
'For each case
'sets cell to zero if they aren't yellow
'Prevents manual inputs from being overwritten
If Selection.Interior.ColorIndex <> 36 Then
Selection.Value = 0
'set to yellow, unlocked, black font
Selection.Interior.ColorIndex = 36
Selection.Locked = False
Selection.Font.ColorIndex = 1
End If
ElseIf inputTypeFound = "GateCycle 6.0" Or inputTypeFound = "GateCycle 5.61" Then
'Find number of times whattoset is repeated in cyclink
numrepeats = WorksheetFunction.CountIf(Worksheets(caseNames(k)).UsedRange, whatToSet(i, j))
'target cell is the cell that needs to be found on the cyclelink tab
'offset it by one cell to the left to get that whatToSet value for the perf summary calc
'the target cell location is initialized
Set targetCellLocation(i, j, k) = Range("A1")
'Go To worksheet with that case name
With Worksheets(caseNames(k)).UsedRange
For lCount = 1 To numrepeats Step 1
'find the what to set value on the cyclink tab for that case and
'save the location to targetcelllocation
On Error GoTo NotFound
Set targetCellLocation(i, j, k) = .Find(What:=whatToSet(i, j), After:=targetCellLocation(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some whatToSet values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
If targetCellLocation(i, j, k).Offset(0, -5).Interior.ColorIndex <> 8 Then
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(0, -1).Value
Exit For
End If
Next lCount
End With
'Sets the target value to the proper cell
Selection.Value = targetValue(i, j, k)
'set to green, locked, black font
Selection.Interior.ColorIndex = 35
Selection.Locked = True
Selection.Font.ColorIndex = 1
End If
Next k
'If there are no more cells to lock/unlock, end loop
If whatToSet(i, j + 1) = "" Then
Exit For
End If
Next j
'If there are no more worksheets to set cells on, end loop
If formulaWkshtName(i + 1) = "" Then
Exit For
End If
Next i
Exit Sub
NotFound:
MsgBox whatToSet(i, j)
Resume Next
End Sub
Sub PFDCyclelinkValues()
Dim i As Integer, j As Integer, k As Integer, whatToSet(10, 50) As String, category As String, sameCase As Boolean
Dim formulaWkshtName(10) As String, formulaCell As Range, targetCellLocation(10, 50, 50), linkValue(0, 50, 50)
Dim targetValue(10, 50, 50), categoryCell As Range, curCaseNum As Integer, choices As String, caseFound As Boolean
Dim lCount As Long, numrepeats As Integer, n As Integer, P As Integer, m As Integer, curCaseName As String
Dim caseNameCell As Range
'worksheet where values for categories below will be written to
formulaWkshtName(0) = "PFD"
category = "Case Name"
'Definitions of categories to be read in from cyclelink to the pfd
whatToSet(0, 0) = "HP Steam Flow"
whatToSet(0, 1) = "HP Superheater Exit Pressure"
whatToSet(0, 2) = "HP Superheater Exit Temperature"
whatToSet(0, 3) = "Steam Turbines Running"
whatToSet(0, 4) = "STG Throttle Pressure"
whatToSet(0, 5) = "Main Steam Throttle Temperature"
whatToSet(0, 6) = "CRH Steam Flow"
whatToSet(0, 7) = "CRH Pressure at STG"
whatToSet(0, 8) = "CRH Temperature at STG"
whatToSet(0, 9) = "HRH Steam Flow"
whatToSet(0, 10) = "HRH Exit Pressure"
whatToSet(0, 11) = "HRH Exit Temperature"
whatToSet(0, 12) = "LP Steam Flow"
whatToSet(0, 13) = "LP Superheater Exit Pressure"
whatToSet(0, 14) = "LP Superheater Exit Temperature"
whatToSet(0, 15) = "Condensate flow"
whatToSet(0, 16) = "Condenser Back Pressure"
whatToSet(0, 17) = "Condensate Temperature"
whatToSet(0, 18) = "CTG Fuel Flow (each)"
whatToSet(0, 19) = "Duct Burner Fuel Flow (each)"
whatToSet(0, 20) = "STG Exhaust Loss"
whatToSet(0, 21) = "STG Exhaust Moisture"
whatToSet(0, 22) = "Gross Output per CTG"
whatToSet(0, 23) = "Gross Output per STG"
whatToSet(0, 24) = "Gas Turbines Running"
whatToSet(0, 25) = "Ambient Dry Bulb Temperature"
whatToSet(0, 26) = "Stack Exit Temperature"
whatToSet(0, 27) = "CTG Exhaust Flow"
whatToSet(0, 28) = "CTG Exhaust Temperature"
whatToSet(0, 29) = "CTG Outlet Back Pressure (Max)"
whatToSet(0, 30) = "CTG Exhaust Enthalpy"
whatToSet(0, 31) = "Ambient Pressure "
whatToSet(0, 32) = "Stack Flow Rate"
whatToSet(0, 33) = "Stack Exhaust Enthalpy"
whatToSet(0, 34) = "Auxiliary Power Percentage"
whatToSet(0, 35) = "HP ST Efficiency"
whatToSet(0, 36) = "IP ST Efficiency"
whatToSet(0, 37) = "LP ST Efficiency"
whatToSet(0, 38) = "Hot Reheat Steam Throttle Flow"
whatToSet(0, 39) = "Hot Reheat Throttle Temperature"
whatToSet(0, 40) = "Hot Reheat Throttle Pressure"
whatToSet(0, 41) = "LP Turbine Steam Flow"
whatToSet(0, 42) = "LP Turbine Steam Temperature"
whatToSet(0, 43) = "LP Turbine Steam Pressure"
' SET VALUES TO CELLS
'Initialize locations
Set formulaCell = Range("A1")
Set categoryCell = Range("A1")
Set caseNameCell = Range("A1")
'activate worksheet
Worksheets(formulaWkshtName(0)).Activate
'using this worksheet
With Worksheets(formulaWkshtName(0)).UsedRange
'find the cell with the case name to be displayed
On Error GoTo NotFound
Set categoryCell = .Find(What:=category, After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
Set caseNameCell = .Find(What:="Description", After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
If categoryCell.Value & " Case" = caseNameCell.Value Then
sameCase = True
Else
sameCase = False
caseNameCell.Value = categoryCell.Value & " Case"
End If
caseFound = False
curCaseNum = 0
If inputTypeFound <> "Manual Input" Then
'determine which case number is found
For k = 0 To numCases Step 1
If categoryCell.Value = caseNames(k) Then
'saves casefound as true
caseFound = True
'saves the case number
curCaseNum = k
End If
'creates a list of the case names to put in drop down menu
If k = 0 Then
choices = caseNames(k)
ElseIf k < numCases Then
choices = choices & ", " & caseNames(k)
ElseIf k = numCases Then
choices = choices & ", " & caseNames(k)
End If
Next k
ElseIf inputTypeFound = "Manual Input" Then
If categoryCell.Value = "Design" Then
'saves casefound as true
caseFound = True
'saves the case number
curCaseNum = 0
ElseIf categoryCell.Value = "Max" Then
'saves casefound as true
caseFound = True
'saves the case number
curCaseNum = 1
End If
'creates a list of the case names to put in drop down menu
choices = "Design, Max"
End If
'selects cell to put drop down menu with case names
categoryCell.Select
'creates the drop down menu
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=choices
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
'if the case currently displayed in the drop down menu box wasn't found in the current cases, show error and exit sub
If caseFound = False Then
MsgBox "Process Flow Diagram case no longer exists"
Exit Sub
End If
'loops through each worksheet cells need to be set on
For i = 0 To 10 Step 1
'activate worksheet
Worksheets(formulaWkshtName(i)).Activate
'Loops through all the categories that need to be set (whatToSet)
For j = 0 To 50 Step 1
'Search for label to set and offsets 2
With Worksheets(formulaWkshtName(i)).UsedRange
'sets cell as cell to be modified
On Error GoTo NotFound
Set formulaCell = .Find(What:=whatToSet(i, j), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'does actions only for the case selected in the drop down menu
For k = curCaseNum To curCaseNum Step 1
'Select Cell to be modified on the PFD
formulaCell.Select
'Check if the input type for manual input or gatecycle input
If inputTypeFound = "Manual Input" Then
numrepeats = WorksheetFunction.CountIf(Worksheets("General Inputs").UsedRange, whatToSet(i, j))
If numrepeats = 1 And whatToSet(i, j) <> "Ambient Dry Bulb Temperature" And whatToSet(i, j) <> "CTG Exhaust Temperature" And whatToSet(i, j) <> "CTG Exhaust Flow" Then
'the target cell location is initialized
Set targetCellLocation(i, j, k) = Range("A1")
'with general inputs page
With Worksheets("General Inputs").UsedRange
'find the what to set value on the cyclink tab for that case and
'save the location to targetcelllocation
On Error GoTo NotFound
Set targetCellLocation(i, j, k) = .Find(What:=whatToSet(i, j), After:=targetCellLocation(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
End With
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(0, k + 2).Value
'Sets the target value to the proper cell
Selection.Value = targetValue(i, j, k)
'set to green, locks cell, and black font
Selection.Interior.ColorIndex = 35
Selection.Locked = True
Selection.Font.ColorIndex = 1
'For this case
'sets cell to zero if it isn't yellow
'Prevents manual inputs from being overwritten
ElseIf Selection.Interior.ColorIndex <> 36 Or sameCase = False Then
Selection.Value = 0
'set to yellow, unlocked, black font
Selection.Interior.ColorIndex = 36
Selection.Locked = False
Selection.Font.ColorIndex = 1
End If
ElseIf inputTypeFound = "GateCycle 6.0" Or inputTypeFound = "GateCycle 5.61" Then
'Find number of times whattoset is repeated in cyclink
numrepeats = WorksheetFunction.CountIf(Worksheets(caseNames(k)).UsedRange, whatToSet(i, j))
'target cell is the cell that needs to be found on the cyclelink tab
'offset it by one cell to the left to get that whatToSet value for the pfd
'the target cell location is initialized
Set targetCellLocation(i, j, k) = Range("A1")
If whatToSet(i, j) <> "Auxiliary Power Percentage" Then
'Go To worksheet with that case name
With Worksheets(caseNames(k)).UsedRange
For lCount = 1 To numrepeats Step 1
'find the what to set value on the cyclink tab for that case and
'save the location to targetcelllocation
On Error GoTo NotFound
Set targetCellLocation(i, j, k) = .Find(What:=whatToSet(i, j), After:=targetCellLocation(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some whatToSet values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
If targetCellLocation(i, j, k).Offset(0, -5).Interior.ColorIndex <> 8 Then
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(0, -1).Value
Exit For
End If
Next lCount
End With
Else
With Worksheets("Aux Load").UsedRange
'find the what to set value on the cyclink tab for that case and
'save the location to targetcelllocation
On Error GoTo NotFound
Set targetCellLocation(i, j, k) = .Find(What:=whatToSet(i, j), After:=targetCellLocation(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some whatToSet values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(0, 2).Value
End With
End If
'Sets the target value to the proper cell
Selection.Value = targetValue(i, j, k)
'set to green, locks cell, and black font
Selection.Interior.ColorIndex = 35
Selection.Locked = True
Selection.Font.ColorIndex = 1
End If
Next k
'If there are no more cells to lock/unlock, end loop
If whatToSet(i, j + 1) = "" Then
Exit For
End If
Next j
'If there are no more worksheets to set cells on, end loop
If formulaWkshtName(i + 1) = "" Then
Exit For
End If
Next i
Exit Sub
NotFound:
MsgBox whatToSet(i, j)
Resume Next
End Sub
Sub hideArrowsOnPFD()
Dim valueCell As Range, i As Integer, wkshtName(1) As String, whatToFind(10) As String, checkValue(10)
Dim whatElseToFind(10) As String, j As Integer, numSTGs As Integer, numCTGS As Integer
'sets worksheets to be used
wkshtName(0) = "PFD"
wkshtName(1) = "General Inputs"
'sets categories that need to be found
whatToFind(0) = "Gas Turbines Running"
whatToFind(1) = "Steam Turbines Running"
whatToFind(2) = "LP Steam Flow"
whatToFind(3) = "HRH Steam Flow"
whatToFind(4) = "CRH Steam Flow"
'sets additional categories that need to be found
whatElseToFind(0) = "Duct Burner"
'activate this sheet
Worksheets(wkshtName(0)).Activate
'initialize this location
Set valueCell = Range("A1")
'for each of the categories (whatToFind)
For i = 0 To 5 Step 1
'find the whatToFind cell and save the location using this worksheet
With Worksheets(wkshtName(0)).UsedRange
'finds cell
On Error GoTo NotFound
Set valueCell = .Find(What:=whatToFind(i), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'stores value of that location
checkValue(i) = valueCell.Value
'if gas turbines running is the category
If whatToFind(i) = "Gas Turbines Running" Then
'save the number of CTGS
numCTGS = checkValue(i)
'if 1 or less ctgs are running, hide these lines, otherwise unhide them
If checkValue(i) <= 1 Then
ActiveSheet.Shapes("Line 151").Visible = False
ActiveSheet.Shapes("Line 156").Visible = False
Else
ActiveSheet.Shapes("Line 151").Visible = True
ActiveSheet.Shapes("Line 156").Visible = True
End If
End If
'if steam turbines running is the category
If whatToFind(i) = "Steam Turbines Running" Then
'save the number of STGS
numSTGs = checkValue(i)
'if no STGs are running then hide the steam turbine and show these lines, otherwise show the turbine and these lines
If checkValue(i) = 0 Then
ActiveSheet.Shapes("AutoShape 1").Visible = False
ActiveSheet.Shapes("Line 233").Visible = True
ActiveSheet.Shapes("Line 234").Visible = True
ActiveSheet.Shapes("Line 235").Visible = True
ActiveSheet.Shapes("Line 236").Visible = True
ActiveSheet.Shapes("Line 257").Visible = True
Else
ActiveSheet.Shapes("AutoShape 1").Visible = True
ActiveSheet.Shapes("Line 233").Visible = False
ActiveSheet.Shapes("Line 234").Visible = False
ActiveSheet.Shapes("Line 235").Visible = False
ActiveSheet.Shapes("Line 236").Visible = False
ActiveSheet.Shapes("Line 257").Visible = False
End If
'if the number of steam turbines running is less than or equal to one, hide them lines, else unhide them
If checkValue(i) <= 1 Then
ActiveSheet.Shapes("Line 173").Visible = False
ActiveSheet.Shapes("Line 178").Visible = False
Else
ActiveSheet.Shapes("Line 173").Visible = True
ActiveSheet.Shapes("Line 178").Visible = True
End If
End If
'if the category is LP steam flow, and the flow is 0 hide these lines, else unhide them
If whatToFind(i) = "LP Steam Flow" Then
If checkValue(i) = 0 Then
ActiveSheet.Shapes("Line 66").Visible = False
ActiveSheet.Shapes("Line 67").Visible = False
ActiveSheet.Shapes("Line 68").Visible = False
ActiveSheet.Shapes("Line 203").Visible = False
ActiveSheet.Shapes("Line 204").Visible = False
ActiveSheet.Shapes("Line 155").Visible = False
ActiveSheet.Shapes("Line 177").Visible = False
ActiveSheet.Shapes("Line 236").Visible = False
Else
ActiveSheet.Shapes("Line 66").Visible = True
ActiveSheet.Shapes("Line 67").Visible = True
ActiveSheet.Shapes("Line 68").Visible = True
ActiveSheet.Shapes("Line 203").Visible = True
ActiveSheet.Shapes("Line 204").Visible = True
'if the # of STGs is more than one show this line, else hide it
If numSTGs > 1 Then
ActiveSheet.Shapes("Line 177").Visible = True
Else
ActiveSheet.Shapes("Line 177").Visible = False
End If
'if the # of CTGs is more than one show this line, else hide it
If numCTGS > 1 Then
ActiveSheet.Shapes("Line 155").Visible = True
Else
ActiveSheet.Shapes("Line 155").Visible = False
End If
End If
End If
'if the category is HRH steam flow, and the flow is 0 hide these lines, else unhide them
If whatToFind(i) = "HRH Steam Flow" Then
If checkValue(i) = 0 Then
ActiveSheet.Shapes("Line 63").Visible = False
ActiveSheet.Shapes("Line 64").Visible = False
ActiveSheet.Shapes("Line 65").Visible = False
ActiveSheet.Shapes("Line 201").Visible = False
ActiveSheet.Shapes("Line 202").Visible = False
ActiveSheet.Shapes("Line 153").Visible = False
ActiveSheet.Shapes("Line 176").Visible = False
ActiveSheet.Shapes("Line 235").Visible = False
Else
ActiveSheet.Shapes("Line 63").Visible = True
ActiveSheet.Shapes("Line 64").Visible = True
ActiveSheet.Shapes("Line 65").Visible = True
ActiveSheet.Shapes("Line 201").Visible = True
ActiveSheet.Shapes("Line 202").Visible = True
'if the # of CTGs is more than one show this line, else hide it
If numCTGS > 1 Then
ActiveSheet.Shapes("Line 153").Visible = True
Else
ActiveSheet.Shapes("Line 153").Visible = False
End If
'if the # of STGs is more than one show this line, else hide it
If numSTGs > 1 Then
ActiveSheet.Shapes("Line 176").Visible = True
Else
ActiveSheet.Shapes("Line 176").Visible = False
End If
End If
End If
'if the category is CRH steam flow, and the flow is 0 or the # of stgs running is 0, hide these lines, else unhide them
If whatToFind(i) = "CRH Steam Flow" Then
If checkValue(i) = 0 Or numSTGs = 0 Then
ActiveSheet.Shapes("Line 60").Visible = False
ActiveSheet.Shapes("Line 61").Visible = False
ActiveSheet.Shapes("Line 62").Visible = False
ActiveSheet.Shapes("Line 73").Visible = False
ActiveSheet.Shapes("Line 200").Visible = False
ActiveSheet.Shapes("Line 199").Visible = False
ActiveSheet.Shapes("Line 152").Visible = False
ActiveSheet.Shapes("Line 175").Visible = False
Else
ActiveSheet.Shapes("Line 60").Visible = True
ActiveSheet.Shapes("Line 61").Visible = True
ActiveSheet.Shapes("Line 62").Visible = True
ActiveSheet.Shapes("Line 73").Visible = True
ActiveSheet.Shapes("Line 200").Visible = True
ActiveSheet.Shapes("Line 199").Visible = True
'if the # of CTGs is more than one show this line, else hide it
If numCTGS > 1 Then
ActiveSheet.Shapes("Line 152").Visible = True
Else
ActiveSheet.Shapes("Line 152").Visible = False
End If
'if the # of STGs is more than one show this line, else hide it
If numSTGs > 1 Then
ActiveSheet.Shapes("Line 175").Visible = True
Else
ActiveSheet.Shapes("Line 175").Visible = False
End If
End If
End If
Next i
'uses the general inputs worksheet to check values on
For j = 0 To 0 Step 1
'with this worksheet
With Worksheets(wkshtName(1)).UsedRange
'finds cell
On Error GoTo NotFound2
Set valueCell = .Find(What:=whatElseToFind(j), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
End With
'stores value of this location
checkValue(j) = valueCell.Value
'when the category is duct burner, if it is set to unfired hide these shapes, else unhide them
If whatElseToFind(j) = "Duct Burner" Then
If checkValue(j) = "Unfired" Then
ActiveSheet.Shapes("Line 79").Visible = False
ActiveSheet.Shapes("Line 80").Visible = False
ActiveSheet.Shapes("Line 205").Visible = False
ActiveSheet.Shapes("Line 206").Visible = False
ActiveSheet.Shapes("Rectangle 74").Visible = False
Else
ActiveSheet.Shapes("Line 79").Visible = True
ActiveSheet.Shapes("Line 80").Visible = True
ActiveSheet.Shapes("Line 205").Visible = True
ActiveSheet.Shapes("Line 206").Visible = True
ActiveSheet.Shapes("Rectangle 74").Visible = True
End If
End If
Next j
Exit Sub
NotFound:
MsgBox whatToFind(i)
Resume Next
NotFound2:
MsgBox whatToFind(j)
Resume Next
End Sub
Sub bypassDSHCyclelinkValues()
Dim i As Integer, j As Integer, k As Integer, category(10) As String, formulaWkshtName(10) As String, formulaCell As Range
Dim whatToSet(10, 50) As String, targetValue(10, 50, 50), categoryCell(10) As Range, curCaseNum(10) As Integer
Dim targetCellLocation(10, 50, 50), linkValue(0, 50, 50), lCount As Long, numrepeats As Integer, n As Integer
Dim P As Integer, m As Integer, choices(10) As String, caseFound(10) As Boolean, maxValueCase(10) As Double
Dim curMaxValue(10) As Double, targetCellLocation2(10, 50, 50), targetValue2(10, 50, 50)
'worksheet where values for categories below will be written to
formulaWkshtName(0) = "Bypass DSH"
'cell name that contains that case name that will be used for the values
category(0) = "HP Bypass Case"
category(1) = "HRH Bypass Case"
category(2) = "LP Bypass Case"
'Definitions of categories to be read in from cyclelink to the bypass dsh calculations
whatToSet(0, 0) = "HP Steam Flow"
whatToSet(0, 1) = "HP Superheater Exit Pressure"
whatToSet(0, 2) = "HP Superheater Exit Temperature"
whatToSet(0, 3) = "CRH Pressure at STG"
whatToSet(0, 4) = "Desired HP Bypass Steam Degrees Superheat"
whatToSet(0, 5) = "HP Spray Water Pressure"
whatToSet(0, 6) = "HP Spray Water Temperature"
whatToSet(1, 0) = "HRH Steam Flow"
whatToSet(1, 1) = "HRH Exit Pressure"
whatToSet(1, 2) = "HRH Exit Temperature"
whatToSet(1, 3) = "Desired HRH Bypass Steam Pressure"
whatToSet(1, 4) = "Desired HRH Bypass Steam Degrees Superheat"
whatToSet(1, 5) = "HRH Spray Water Pressure"
whatToSet(1, 6) = "HRH Spray Water Temperature"
whatToSet(2, 0) = "LP Steam Flow"
whatToSet(2, 1) = "LP Superheater Exit Pressure"
whatToSet(2, 2) = "LP Superheater Exit Temperature"
'whatToSet(2, 3) = "Spray Water from Condensate Temperature"
'whatToSet(2, 4) = "Spray Water from Condensate Pressure"
' SET VALUES TO CELLS
'Initialize location
Set formulaCell = Range("A1")
Set categoryCell(i) = Range("A1")
'activate this worksheet
Worksheets(formulaWkshtName(0)).Activate
'using this worksheet
For i = 0 To 2 Step 1
With Worksheets(formulaWkshtName(0)).UsedRange
'sets cell the location of the cell with the case name to be used for calculation
'On Error GoTo NotFound
Set categoryCell(i) = .Find(What:=category(i), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
End With
'for each case check
curMaxValue(i) = 0
For k = 0 To numCases Step 1
If categoryCell(i).Value = "Max Flow" And inputTypeFound <> "Manual Input" Then
'i = category --> HP, HRH, LP
'k = case number
j = 0
'Find number of times whattoset is repeated in cyclink
numrepeats = WorksheetFunction.CountIf(Worksheets(caseNames(k)).UsedRange, whatToSet(i, j))
'target cell is the cell that needs to be found on the cyclelink tab
'offset it by one cell to the left to get that whatToSet value for the bypass dsh calc
'the target cell location is initialized
Set targetCellLocation(i, j, k) = Range("A1")
Set targetCellLocation2(i, j, k) = Range("A1")
'Go To worksheet with that case name
With Worksheets(caseNames(k)).UsedRange
For lCount = 1 To numrepeats Step 1
'find the what to set value on the cyclink tab for that case and
'save the location to targetcelllocation
On Error GoTo NotFound
Set targetCellLocation(i, j, k) = .Find(What:=whatToSet(i, j), After:=targetCellLocation(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some whatToSet values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
If targetCellLocation(i, j, k).Offset(0, -5).Interior.ColorIndex <> 8 Then
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(0, -1).Value
Exit For
End If
Set targetCellLocation2(i, j, k) = .Find(What:="Supplementary Firing (SF)", After:=targetCellLocation2(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some whatToSet values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
If targetCellLocation2(i, j, k).Offset(0, -5).Interior.ColorIndex <> 8 Then
targetValue2(i, j, k) = targetCellLocation2(i, j, k).Offset(0, -1).Value
Exit For
End If
Next lCount
End With
If targetValue(i, j, k) > curMaxValue(i) And targetValue2(i, j, k) = "NO" Then
curMaxValue(i) = targetValue(i, j, k)
curCaseNum(i) = k
End If
End If
'if the case is found in the case names array or is set to manual input
If categoryCell(i).Value = caseNames(k) Or categoryCell(i).Value = "Manual Input" Then
caseFound(i) = True
End If
'saves the number of the cases
If categoryCell(i).Value = caseNames(k) Then
curCaseNum(i) = k
End If
'creates a list to put in the drop down menu of case names
If inputTypeFound <> "Manual Input" Then
If k = 0 Then
choices(i) = "Manual Input, Max Flow, " & caseNames(k)
ElseIf k < numCases Then
choices(i) = choices(i) & ", " & caseNames(k)
ElseIf k = numCases Then
choices(i) = choices(i) & ", " & caseNames(k)
End If
End If
Next k
If inputTypeFound = "Manual Input" Then
choices(i) = "Manual Input, Design, Max"
If categoryCell(i).Value = "Manual Input" Or categoryCell(i).Value = "Design" Or categoryCell(i).Value = "Max" Then
caseFound(i) = True
End If
End If
'selects the cells that contains the drop down menu
categoryCell(i).Select
'creates the drop menu in that cell
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=choices(i)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
'if none of the case names were found set the value to manual input
If caseFound(i) = False And inputTypeFound <> "Manual Input" Then
categoryCell(i).Value = "Max Flow"
ElseIf inputTypeFound = "Manual Input" And categoryCell(i).Value <> "Design" And categoryCell(i).Value <> "Max" Then
categoryCell(i).Value = "Manual Input"
End If
Next i
'loops through each group that needs to be set on
For i = 0 To 10 Step 1
'activate worksheet
Worksheets(formulaWkshtName(0)).Activate
'Loops through all the categories that need to be set (whatToSet)
For j = 0 To 50 Step 1
'Search for label to set and offsets 2
With Worksheets(formulaWkshtName(0)).UsedRange
'sets cell as cell to be modified
'On Error GoTo NotFound
Set formulaCell = .Find(What:=whatToSet(i, j), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'does actions only for the case number found earlier
For k = curCaseNum(i) To curCaseNum(i) Step 1
'Select Cell to be modified on the bypass dsh
formulaCell.Select
'Check if the input type for manual input or cyclelink input
If categoryCell(i).Value = "Manual Input" Then
'For each case
'sets cell to zero if they aren't yellow
'Prevents manual inputs from being overwritten
If Selection.Interior.ColorIndex <> 36 Then
Selection.Value = 0
'set to yellow, unlocked, black font
Selection.Interior.ColorIndex = 36
Selection.Locked = False
Selection.Font.ColorIndex = 1
End If
'if the categorycell.value is a case number
ElseIf inputTypeFound = "Manual Input" And (categoryCell(i).Value = "Design" Or categoryCell(i).Value = "Max") Then
If categoryCell(i).Value = "Design" Then
n = 2
ElseIf categoryCell(i).Value = "Max" Then
n = 3
End If
'the target cell location is initialized
Set targetCellLocation(i, j, k) = Range("A1")
With Worksheets("General Inputs").UsedRange
'find the what to set value on the general inputs tab for that case and
'save the location to targetcelllocation
'On Error GoTo NotFound
Set targetCellLocation(i, j, k) = .Find(What:=whatToSet(i, j), After:=targetCellLocation(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(0, n).Value
End With
'Sets the target value to the proper cell
Selection.Value = targetValue(i, j, k)
'set to green, locked, black font
Selection.Interior.ColorIndex = 35
Selection.Locked = True
Selection.Font.ColorIndex = 1
Else
'Find number of times whattoset is repeated in cyclink
numrepeats = WorksheetFunction.CountIf(Worksheets(caseNames(k)).UsedRange, whatToSet(i, j))
'target cell is the cell that needs to be found on the cyclelink tab
'offset it by one cell to the left to get that whatToSet value for the bypass dsh calc
'the target cell location is initialized
Set targetCellLocation(i, j, k) = Range("A1")
'Go To worksheet with that case name
With Worksheets(caseNames(k)).UsedRange
For lCount = 1 To numrepeats Step 1
'find the what to set value on the cyclink tab for that case and
'save the location to targetcelllocation
On Error GoTo NotFound
Set targetCellLocation(i, j, k) = .Find(What:=whatToSet(i, j), After:=targetCellLocation(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some whatToSet values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
If targetCellLocation(i, j, k).Offset(0, -5).Interior.ColorIndex <> 8 Then
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(0, -1).Value
Exit For
End If
Next lCount
End With
'Sets the target value to the proper cell
Selection.Value = targetValue(i, j, k)
'set to green, locked, black font
Selection.Interior.ColorIndex = 35
Selection.Locked = True
Selection.Font.ColorIndex = 1
End If
Next k
'If there are no more cells to lock/unlock, end loop
If whatToSet(i, j + 1) = "" Then
Exit For
End If
Next j
'If there are no more categories to set cells, end loop
If category(i + 1) = "" Then
Exit For
End If
Next i
Exit Sub
NotFound:
MsgBox whatToSet(i, j)
Resume Next
End Sub
Sub ammoniaComsumptionCyclelinkValues()
Dim i As Integer, j As Integer, k As Integer, category(10) As String, formulaWkshtName(10) As String, formulaCell As Range
Dim whatToSet(10, 50) As String, targetValue(10, 50, 50), categoryCell(10) As Range, curCaseNum(10) As Integer
Dim targetCellLocation(10, 50, 50), linkValue(0, 50, 50), lCount As Long, numrepeats As Integer, n As Integer
Dim P As Integer, m As Integer, choices(10) As String, caseFound(10) As Boolean, maxValueCase(10) As Double
Dim curMaxValue(10) As Double
'worksheet where values for categories below will be written to
formulaWkshtName(0) = "Ammonia"
'cell name that contains that case name that will be used for the values
category(0) = "Ammonia Consumption Sizing Case"
'Definitions of categories to be read in from cyclelink to the bypass dsh calculations
whatToSet(0, 0) = "CTG Exhaust Flow"
whatToSet(0, 1) = "Nitrogen"
whatToSet(0, 2) = "Oxygen"
whatToSet(0, 3) = "Carbon Dioxide"
whatToSet(0, 4) = "Water"
whatToSet(0, 5) = "Duct Burner Fuel Flow (each)"
whatToSet(0, 6) = "Argon"
' SET VALUES TO CELLS
'Initialize location
Set formulaCell = Range("A1")
Set categoryCell(i) = Range("A1")
'activate this worksheet
Worksheets(formulaWkshtName(0)).Activate
'using this worksheet
For i = 0 To 0 Step 1
With Worksheets(formulaWkshtName(0)).UsedRange
'sets cell the location of the cell with the case name to be used for calculation
'On Error GoTo NotFound
Set categoryCell(i) = .Find(What:=category(i), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
End With
'for each case check
curMaxValue(i) = 0
'LOOP DETERMINES WHAT CASE SHOULD BE USED AND SAVES THE CASE NUMBER
For k = 0 To numCases Step 1
If categoryCell(i).Value = "Max Exhaust Flow" And inputTypeFound <> "Manual Input" Then
'i = category
'k = case number
j = 0
'Find number of times whattoset is repeated in cyclink
numrepeats = WorksheetFunction.CountIf(Worksheets(caseNames(k)).UsedRange, whatToSet(i, j))
'target cell is the cell that needs to be found on the cyclelink tab
'offset it by one cell to the left to get that whatToSet value for the bypass dsh calc
'the target cell location is initialized
Set targetCellLocation(i, j, k) = Range("A1")
'Go To worksheet with that case name
With Worksheets(caseNames(k)).UsedRange
For lCount = 1 To numrepeats Step 1
'find the what to set value on the cyclink tab for that case and
'save the location to targetcelllocation
On Error GoTo NotFound
Set targetCellLocation(i, j, k) = .Find(What:=whatToSet(i, j), After:=targetCellLocation(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some whatToSet values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
If targetCellLocation(i, j, k).Offset(0, -5).Interior.ColorIndex <> 8 Then
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(0, -1).Value
Exit For
End If
Next lCount
End With
If targetValue(i, j, k) > curMaxValue(i) Then
curMaxValue(i) = targetValue(i, j, k)
curCaseNum(i) = k
End If
End If
'if the case is found in the case names array or is set to manual input
If categoryCell(i).Value = caseNames(k) Or categoryCell(i).Value = "Manual Input" Then
caseFound(i) = True
End If
'saves the number of the cases
If categoryCell(i).Value = caseNames(k) Then
curCaseNum(i) = k
End If
'creates a list to put in the drop down menu of case names
If inputTypeFound <> "Manual Input" Then
If k = 0 Then
choices(i) = "Manual Input, Max Exhaust Flow, " & caseNames(k)
ElseIf k < numCases Then
choices(i) = choices(i) & ", " & caseNames(k)
ElseIf k = numCases Then
choices(i) = choices(i) & ", " & caseNames(k)
End If
End If
Next k
If inputTypeFound = "Manual Input" Then
choices(i) = "Manual Input, Design, Max Exhaust Flow"
If categoryCell(i).Value = "Manual Input" Or categoryCell(i).Value = "Design" Or categoryCell(i).Value = "Max Exhaust Flow" Then
caseFound(i) = True
End If
End If
'selects the cells that contains the drop down menu
categoryCell(i).Select
'creates the drop menu in that cell
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=choices(i)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
'if none of the case names were found set the value to manual input
If caseFound(i) = False And inputTypeFound <> "Manual Input" Then
categoryCell(i).Value = "Max Exhaust Flow"
ElseIf inputTypeFound = "Manual Input" And categoryCell(i).Value <> "Design" And categoryCell(i).Value <> "Max Exhaust Flow" Then
categoryCell(i).Value = "Manual Input"
End If
Next i
'loops through each group that needs to be set on
For i = 0 To 10 Step 1
'activate worksheet
Worksheets(formulaWkshtName(0)).Activate
'Loops through all the categories that need to be set (whatToSet)
For j = 0 To 50 Step 1
'Search for label to set and offsets 2
With Worksheets(formulaWkshtName(0)).UsedRange
'sets cell as cell to be modified
'On Error GoTo NotFound
Set formulaCell = .Find(What:=whatToSet(i, j), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'does actions only for the case number found earlier
For k = curCaseNum(i) To curCaseNum(i) Step 1
'Select Cell to be modified on the bypass dsh
formulaCell.Select
'Check if the input type for manual input or cyclelink input
If categoryCell(i).Value = "Manual Input" Then
'For each case
'sets cell to zero if they aren't yellow
'Prevents manual inputs from being overwritten
If Selection.Interior.ColorIndex <> 36 Then
Selection.Value = 0
'set to yellow, unlocked, black font
Selection.Interior.ColorIndex = 36
Selection.Locked = False
Selection.Font.ColorIndex = 1
End If
'if the categorycell.value is a case number
ElseIf inputTypeFound = "Manual Input" And (categoryCell(i).Value = "Design" Or categoryCell(i).Value = "Max Exhaust Flow") Then
If categoryCell(i).Value = "Design" Then
n = 2
ElseIf categoryCell(i).Value = "Max Exhaust Flow" Then
n = 3
End If
'the target cell location is initialized
Set targetCellLocation(i, j, k) = Range("A1")
With Worksheets("General Inputs").UsedRange
'find the what to set value on the general inputs tab for that case and
'save the location to targetcelllocation
'On Error GoTo NotFound
Set targetCellLocation(i, j, k) = .Find(What:=whatToSet(i, j), After:=targetCellLocation(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(0, n).Value
End With
'Sets the target value to the proper cell
Selection.Value = targetValue(i, j, k)
'set to green, locked, black font
Selection.Interior.ColorIndex = 35
Selection.Locked = True
Selection.Font.ColorIndex = 1
Else
'Find number of times whattoset is repeated in cyclink
numrepeats = WorksheetFunction.CountIf(Worksheets(caseNames(k)).UsedRange, whatToSet(i, j))
'target cell is the cell that needs to be found on the cyclelink tab
'offset it by one cell to the left to get that whatToSet value for the bypass dsh calc
'the target cell location is initialized
Set targetCellLocation(i, j, k) = Range("A1")
'Go To worksheet with that case name
With Worksheets(caseNames(k)).UsedRange
For lCount = 1 To numrepeats Step 1
'find the what to set value on the cyclink tab for that case and
'save the location to targetcelllocation
On Error GoTo NotFound
Set targetCellLocation(i, j, k) = .Find(What:=whatToSet(i, j), After:=targetCellLocation(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some whatToSet values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
If targetCellLocation(i, j, k).Offset(0, -5).Interior.ColorIndex <> 8 Then
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(0, -1).Value
Exit For
End If
Next lCount
End With
'Sets the target value to the proper cell
Selection.Value = targetValue(i, j, k)
'set to green, locked, black font
Selection.Interior.ColorIndex = 35
Selection.Locked = True
Selection.Font.ColorIndex = 1
End If
Next k
'If there are no more cells to lock/unlock, end loop
If whatToSet(i, j + 1) = "" Then
Exit For
End If
Next j
'If there are no more categories to set cells, end loop
If category(i + 1) = "" Then
Exit For
End If
Next i
Exit Sub
NotFound:
MsgBox whatToSet(i, j)
Resume Next
End Sub
Sub pipeSizingCycleLinkValues()
Call casesAndInputs
Dim i As Integer, j As Integer, k As Integer, category(25) As String, formulaWkshtName(25) As String, formulaCell(25, 50)
Dim whatToSet(25, 50) As String, targetValue(25, 50, 50), categoryCell(25) As Range, curCaseNum(25) As Integer
Dim targetCellLocation(25, 50, 50), linkValue(25, 50, 50), lCount As Long, numrepeats As Integer, n As Integer
Dim P As Integer, m As Integer, choices(25) As String, caseFound(25) As Boolean, maxValueCase(25) As Double
Dim curMaxValue(25) As Double, numOffset As Integer, r As Integer, c As Integer
'worksheet where values for categories below will be written to
formulaWkshtName(0) = "Pipe Sizing"
'Definitions of categories to be read in from cyclelink to the bypass dsh calculations
whatToSet(0, 0) = "HP Steam Flow"
whatToSet(0, 1) = "HP Superheater Exit Pressure"
whatToSet(0, 2) = "HP Superheater Exit Temperature"
whatToSet(1, 0) = "Main Steam Throttle Flow"
whatToSet(1, 1) = "HP Superheater Exit Pressure"
whatToSet(1, 2) = "HP Superheater Exit Temperature"
whatToSet(2, 0) = "HRH Steam Flow"
whatToSet(2, 1) = "HRH Exit Pressure"
whatToSet(2, 2) = "HRH Exit Temperature"
whatToSet(3, 0) = "Hot Reheat Steam Throttle Flow"
whatToSet(3, 1) = "HRH Exit Pressure"
whatToSet(3, 2) = "HRH Exit Temperature"
whatToSet(4, 0) = "Cold Reheat Steam Flow"
whatToSet(4, 1) = "CRH Pressure at STG"
whatToSet(4, 2) = "CRH Temperature at STG"
whatToSet(5, 0) = "CRH Steam Flow"
whatToSet(5, 1) = "CRH Pressure at STG"
whatToSet(5, 2) = "CRH Temperature at STG"
whatToSet(6, 0) = "LP Steam Flow"
whatToSet(6, 1) = "LP Superheater Exit Pressure"
whatToSet(6, 2) = "LP Superheater Exit Temperature"
whatToSet(7, 0) = "Total LP Steam Flow"
whatToSet(7, 1) = "LP Superheater Exit Pressure"
whatToSet(7, 2) = "LP Superheater Exit Temperature"
whatToSet(8, 0) = "Total Feedwater Flow"
whatToSet(8, 1) = "Suction Pressure"
whatToSet(8, 2) = "Suction Temperature"
whatToSet(9, 0) = "Feedwater Suction Flow per Pump"
whatToSet(9, 1) = "Suction Pressure"
whatToSet(9, 2) = "Suction Temperature"
whatToSet(10, 0) = "IP Feedwater Flow per Pump"
whatToSet(10, 1) = "IP Discharge Pressure"
whatToSet(10, 2) = "IP Discharge Temperature"
whatToSet(11, 0) = "IP Feedwater Flow"
whatToSet(11, 1) = "IP Discharge Pressure"
whatToSet(11, 2) = "IP Discharge Temperature"
whatToSet(12, 0) = "HP Feedwater Flow per Pump"
whatToSet(12, 1) = "HP Discharge Pressure"
whatToSet(12, 2) = "HP Discharge Temperature"
whatToSet(13, 0) = "HP Feedwater Flow"
whatToSet(13, 1) = "HP Discharge Pressure"
whatToSet(13, 2) = "HP Discharge Temperature"
whatToSet(14, 0) = "Condensate Flow"
whatToSet(14, 1) = "Condensate Suction Pressure"
whatToSet(14, 2) = "Condensate Temperature"
whatToSet(15, 0) = "Condensate Flow per Pump"
whatToSet(15, 1) = "Condensate Suction Pressure"
whatToSet(15, 2) = "Condensate Temperature"
whatToSet(16, 0) = "Condensate Discharge Flow per Pump"
whatToSet(16, 1) = "LP Spray Water from Condensate Temperature"
whatToSet(16, 2) = "LP Spray Water from Condensate Pressure"
whatToSet(17, 0) = "Condensate Discharge Flow"
whatToSet(17, 1) = "LP Spray Water from Condensate Temperature"
whatToSet(17, 2) = "LP Spray Water from Condensate Pressure"
whatToSet(18, 0) = "Condensate Flow per HRSG"
whatToSet(18, 1) = "LP Spray Water from Condensate Temperature"
whatToSet(18, 2) = "LP Spray Water from Condensate Pressure"
whatToSet(19, 0) = "Total Fuel Flow"
whatToSet(20, 0) = "CTG Fuel Flow (each)"
whatToSet(21, 0) = "Duct Burner Fuel Flow (each)"
' SET VALUES TO CELLS
'activate this worksheet
Worksheets(formulaWkshtName(0)).Activate
Columns(16).EntireColumn.Hidden = False
Columns(3).EntireColumn.Hidden = False
Columns(5).EntireColumn.Hidden = False
'Initialize Location
Set categoryCell(i) = Range("A1")
'i = category --> HP, HRH, LP, etc
'k = case number
j = 0
numOffset = -14
For i = 0 To 21 Step 1
With Worksheets(formulaWkshtName(0)).UsedRange
'sets cell the location of the cell with the case name to be used for calculation
'On Error GoTo NotFound
Set categoryCell(i) = .Find(What:=whatToSet(i, 0), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, numOffset)
End With
curMaxValue(i) = 0
For k = 0 To numCases Step 1
If categoryCell(i).Value = "Max Flow" And inputTypeFound <> "Manual Input" Then
'Find number of times whattoset is repeated in cyclink
numrepeats = WorksheetFunction.CountIf(Worksheets(caseNames(k)).UsedRange, whatToSet(i, j))
'target cell is the cell that needs to be found on the cyclelink tab
'offset it by one cell to the left to get that whatToSet value for the bypass dsh calc
'the target cell location is initialized
Set targetCellLocation(i, j, k) = Range("A1")
'Go To worksheet with that case name
With Worksheets(caseNames(k)).UsedRange
For lCount = 1 To numrepeats Step 1
'find the what to set value on the cyclink tab for that case and
'save the location to targetcelllocation
'On Error GoTo NotFound
Set targetCellLocation(i, j, k) = .Find(What:=whatToSet(i, j), After:=targetCellLocation(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some whatToSet values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
If targetCellLocation(i, j, k).Offset(0, -5).Interior.ColorIndex <> 8 Then
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(0, -1).Value
Exit For
End If
Next lCount
End With
If targetValue(i, j, k) > curMaxValue(i) Then
curMaxValue(i) = targetValue(i, j, k)
curCaseNum(i) = k
End If
End If
'if the case is found in the case names array or is set to manual input
If categoryCell(i).Value = caseNames(k) Or categoryCell(i).Value = "Manual Input" Then
caseFound(i) = True
End If
'saves the number of the cases
If categoryCell(i).Value = caseNames(k) Then
curCaseNum(i) = k
End If
'creates a list to put in the drop down menu of case names
If inputTypeFound <> "Manual Input" Then
If k = 0 Then
choices(i) = "Manual Input, Max Flow, " & caseNames(k)
ElseIf k < numCases Then
choices(i) = choices(i) & ", " & caseNames(k)
ElseIf k = numCases Then
choices(i) = choices(i) & ", " & caseNames(k)
End If
End If
Next k
If inputTypeFound = "Manual Input" Then
choices(i) = "Manual Input"
If categoryCell(i).Value = "Manual Input" Then
caseFound(i) = True
End If
End If
'selects the cells that contains the drop down menu
categoryCell(i).Select
'creates the drop menu in that cell
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=choices(i)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
'if none of the case names were found set the value to manual input
If caseFound(i) = False And inputTypeFound <> "Manual Input" Then
categoryCell(i).Value = "Max Flow"
ElseIf inputTypeFound = "Manual Input" Then
categoryCell(i).Value = "Manual Input"
End If
Next i
'loops through each group that needs to be set on
For i = 0 To 21 Step 1
'activate worksheet
Worksheets(formulaWkshtName(0)).Activate
'Loops through all the categories that need to be set (whatToSet)
For j = 0 To 2 Step 1
'numrepeats = WorksheetFunction.CountIf(Worksheets("Pipe Sizing").UsedRange, whatToSet(i, j))
'target cell is the cell that needs to be found on the cyclelink tab
'offset it by one cell to the left to get that whatToSet value
'the target cell location is initialized
Set formulaCell(i, j) = Range("A1")
'Go To worksheet with that case name
With Worksheets("Pipe Sizing").UsedRange
'On Error GoTo NotFound
Set formulaCell(i, j) = .Find(What:=whatToSet(i, j), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
c = formulaCell(i, j).Column
Set formulaCell(i, j) = Range(Cells(categoryCell(i).Row, c), Cells(categoryCell(i).Row, c))
End With
'does actions only for the case number found earlier
For k = curCaseNum(i) To curCaseNum(i) Step 1
'Select Cell to be modified
formulaCell(i, j).Select
'Check if the input type for manual input or cyclelink input
If inputTypeFound = "Manual Input" Or categoryCell(i).Value = "Manual Input" Then
'For each case
'sets cell to zero if they aren't yellow
'Prevents manual inputs from being overwritten
If Selection.Interior.ColorIndex <> 36 Then
Selection.Value = 0
'set to yellow, unlocked, black font
Selection.Interior.ColorIndex = 36
Selection.Locked = False
Selection.Font.ColorIndex = 1
End If
Else
'Find number of times whattoset is repeated in cyclink
numrepeats = WorksheetFunction.CountIf(Worksheets(caseNames(k)).UsedRange, whatToSet(i, j))
'target cell is the cell that needs to be found on the cyclelink tab
'offset it by one cell to the left to get that whatToSet value
'the target cell location is initialized
Set targetCellLocation(i, j, k) = Range("A1")
'Go To worksheet with that case name
With Worksheets(caseNames(k)).UsedRange
For lCount = 1 To numrepeats Step 1
'find the what to set value on the cyclink tab for that case and
'save the location to targetcelllocation
'On Error GoTo NotFound
Set targetCellLocation(i, j, k) = .Find(What:=whatToSet(i, j), After:=targetCellLocation(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some whatToSet values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
If targetCellLocation(i, j, k).Offset(0, -5).Interior.ColorIndex <> 8 Then
targetValue(i, j, k) = targetCellLocation(i, j, k).Offset(0, -1).Value
Exit For
End If
Next lCount
End With
'Sets the target value to the proper cell
Selection.Value = targetValue(i, j, k)
'set to green, locked, black font
Selection.Interior.ColorIndex = 35
Selection.Locked = True
Selection.Font.ColorIndex = 1
End If
Next k
'If there are no more cells to lock/unlock, end loop
If whatToSet(i, j + 1) = "" Then
Exit For
End If
Next j
'If there are no more categories to set cells, end loop
If whatToSet(i + 1, 0) = "" Then
Exit For
End If
Next i
Worksheets(formulaWkshtName(0)).Activate
Columns(16).EntireColumn.Hidden = True
Columns(3).EntireColumn.Hidden = True
Columns(5).EntireColumn.Hidden = True
Exit Sub
NotFound:
MsgBox whatToSet(i, j)
Resume Next
End Sub
Sub findMaxDuties()
Dim i As Integer, j As Integer, k As Integer, whatToSet(10, 50) As String, P As Integer, m As Integer
Dim category As String, wkshtName As String, formulaWkshtName(10) As String, formulaCell As Range, lCount As Long
Dim targetCellLocation(10, 50, 50), linkValue(0, 50, 50), targetValue(10, 50, 50), numrepeats As Integer
Dim whatToCheck(10, 50) As String, thingsToSet(10, 50) As String, checkWkshtName(10) As String, setCell As Range
Dim checkCell As Range, curMaxValue(10, 50) As Double, curMaxCaseNum As Integer, toSetWkshtName(10) As String
Dim cyclelinkLocation(10, 50) As Range, cyclelinkValue(10, 50) As Double, n As Integer
'sets the first worksheet to be used
checkWkshtName(0) = "Emissions Calculation"
whatToCheck(0, 0) = "HRSG Duty"
'defines values that will be set based on the max HRSG Duty case
toSetWkshtName(0) = "General Inputs"
thingsToSet(0, 0) = "CTG Exhaust Flow"
thingsToSet(0, 1) = "CTG Exhaust Temperature"
thingsToSet(0, 2) = "Argon"
thingsToSet(0, 3) = "Nitrogen"
thingsToSet(0, 4) = "Oxygen"
thingsToSet(0, 5) = "Carbon Dioxide"
thingsToSet(0, 6) = "Water"
'sets the second worksheet to be used
checkWkshtName(1) = caseNames(0)
whatToCheck(1, 0) = "Condenser Duty"
'defines values that will be set based on the max condenser Duty case
toSetWkshtName(1) = "General Inputs"
thingsToSet(1, 0) = "Condenser Duty"
thingsToSet(1, 1) = "CW Flow Rate"
thingsToSet(1, 2) = "Cooling Tower Duty "
'sets the second worksheet to be used
checkWkshtName(2) = caseNames(0)
whatToCheck(2, 0) = "Maximum Condenser Back Pressure"
'defines values that will be set based on the max condenser pressure case
toSetWkshtName(2) = "General Inputs"
thingsToSet(2, 0) = "Maximum Condenser Back Pressure"
'sets the second worksheet to be used
checkWkshtName(3) = caseNames(0)
whatToCheck(3, 0) = "Maximum Condensate Flow"
'defines values that will be set based on the max condenser pressure case
toSetWkshtName(3) = "General Inputs"
thingsToSet(3, 0) = "Maximum Condensate Flow"
thingsToSet(3, 1) = "Back Pressure of Max Flow Case"
thingsToSet(3, 2) = "LP Drum Pressure of Max Flow Case"
'Initialize cell to check
Set checkCell = Range("A1")
'Check cell
For i = 0 To 10 Step 1
If inputTypeFound <> "Manual Input" Then
'activate worksheet
Worksheets(checkWkshtName(i)).Activate
'Loops through all the cells to be locked or unlocked
For j = 0 To 50 Step 1
'for the HRSG max duty case
If i = 0 Then
'Search for cell that will be checked for max values and save the location
With Worksheets(checkWkshtName(i)).UsedRange
On Error GoTo NotFoundWhatToCheck
Set checkCell = .Find(What:=whatToCheck(i, j), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'initialize max value to 0
curMaxValue(i, j) = 0
'for all cases
For k = 0 To numCases Step 1
'Select Cell, offset one cell for each case
checkCell.Offset(0, k).Select
'if the current selection value is greater than the current maximum value found
'set that value to the current max
'and save the case number
If Selection.Value >= curMaxValue(i, j) Then
curMaxValue(i, j) = Selection.Value
curMaxCaseNum = k
End If
Next k
'for the the max condenser duty case
ElseIf i = 1 Then
'initialize location for storing the values
Set cyclelinkLocation(i, j) = Range("A1")
'for all the cases
For k = 0 To numCases Step 1
'activate this cases worksheet
Worksheets(caseNames(k)).Activate
'find the number of times the what to check value is repeated
numrepeats = WorksheetFunction.CountIf(Worksheets(caseNames(k)).UsedRange, whatToCheck(i, j))
'Search for cell that will be checked for max values
With Worksheets(caseNames(k)).UsedRange
For lCount = 1 To numrepeats Step 1
On Error GoTo NotFoundWhatToCheck
Set cyclelinkLocation(i, j) = .Find(What:=whatToCheck(1, 0), After:=cyclelinkLocation(i, j), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some whatToCheck values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
If cyclelinkLocation(i, j).Offset(0, -5).Interior.ColorIndex <> 8 Then
cyclelinkValue(i, j) = cyclelinkLocation(i, j).Offset(0, -1).Value
'exit the loop if the proper value is found
Exit For
End If
Next lCount
End With
'if the current selection value is greater than the current maximum value found
'set that value to the current max
'and save the case number
If cyclelinkValue(i, j) >= curMaxValue(i, j) Then
curMaxValue(i, j) = cyclelinkValue(i, j)
curMaxCaseNum = k
End If
Next k
ElseIf i = 2 Then
'initialize location for storing the values
Set cyclelinkLocation(i, j) = Range("A1")
'for all the cases
For k = 0 To numCases Step 1
'activate this cases worksheet
Worksheets(caseNames(k)).Activate
'find the number of times the what to check value is repeated
numrepeats = WorksheetFunction.CountIf(Worksheets(caseNames(k)).UsedRange, whatToCheck(i, j))
'Search for cell that will be checked for max values
With Worksheets(caseNames(k)).UsedRange
For lCount = 1 To numrepeats Step 1
On Error GoTo NotFoundWhatToCheck
Set cyclelinkLocation(i, j) = .Find(What:=whatToCheck(2, 0), After:=cyclelinkLocation(i, j), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some whatToCheck values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
If cyclelinkLocation(i, j).Offset(0, -5).Interior.ColorIndex <> 8 Then
cyclelinkValue(i, j) = cyclelinkLocation(i, j).Offset(0, -1).Value
'exit the loop if the proper value is found
Exit For
End If
Next lCount
End With
'if the current selection value is greater than the current maximum value found
'set that value to the current max
'and save the case number
If cyclelinkValue(i, j) >= curMaxValue(i, j) Then
curMaxValue(i, j) = cyclelinkValue(i, j)
curMaxCaseNum = k
End If
Next k
ElseIf i = 3 Then
'initialize location for storing the values
Set cyclelinkLocation(i, j) = Range("A1")
'for all the cases
For k = 0 To numCases Step 1
'activate this cases worksheet
Worksheets(caseNames(k)).Activate
'find the number of times the what to check value is repeated
numrepeats = WorksheetFunction.CountIf(Worksheets(caseNames(k)).UsedRange, whatToCheck(i, j))
'Search for cell that will be checked for max values
With Worksheets(caseNames(k)).UsedRange
For lCount = 1 To numrepeats Step 1
On Error GoTo NotFoundWhatToCheck
Set cyclelinkLocation(i, j) = .Find(What:=whatToCheck(3, 0), After:=cyclelinkLocation(i, j), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some whatToCheck values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
If cyclelinkLocation(i, j).Offset(0, -5).Interior.ColorIndex <> 8 Then
cyclelinkValue(i, j) = cyclelinkLocation(i, j).Offset(0, -1).Value
'exit the loop if the proper value is found
Exit For
End If
Next lCount
End With
'if the current selection value is greater than the current maximum value found
'set that value to the current max
'and save the case number
If cyclelinkValue(i, j) >= curMaxValue(i, j) Then
curMaxValue(i, j) = cyclelinkValue(i, j)
curMaxCaseNum = k
End If
Next k
End If
'If there are no more cells to check, end loop
If whatToCheck(i, j + 1) = "" Then
Exit For
End If
Next j
End If
Worksheets(toSetWkshtName(i)).Activate
'for each of the items listed that need to be set
For m = 0 To 100
If inputTypeFound <> "Manual Input" Then
'Intialize the location of those values on the cyclelink tab
Set cyclelinkLocation(i, m) = Range("A1")
'find the number of times the thing to set value is repeated
numrepeats = WorksheetFunction.CountIf(Worksheets(caseNames(curMaxCaseNum)).UsedRange, thingsToSet(i, m))
'Using the cyclelink tab of the case that has the maximum value
With Worksheets(caseNames(curMaxCaseNum)).UsedRange
For lCount = 1 To numrepeats Step 1
'save the location of the thingsToSet on the cyclelink tab
On Error GoTo NotFoundThingsToSet
Set cyclelinkLocation(i, m) = .Find(What:=thingsToSet(i, m), After:=cyclelinkLocation(i, m), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Some thingsToSet values are repeated on the cyclelink tabs
'But the left most column should be turquoise for all but one of them
'Chooses the match that isnt excluded from cycle link, denoted by the turquoise color: index 8
If cyclelinkLocation(i, m).Offset(0, -5).Interior.ColorIndex <> 8 Then
cyclelinkValue(i, m) = cyclelinkLocation(i, m).Offset(0, -1).Value
'when the correct value is found exit the for loop
Exit For
End If
Next lCount
End With
End If
'Intialize the cell location for the cells that will be given the values of the things to set
Set setCell = Range("A1")
'using this worksheet
With Worksheets(toSetWkshtName(i)).UsedRange
'find the cell and save the location
On Error GoTo NotFoundThingsToSet
Set setCell = .Find(What:=thingsToSet(i, m), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'if its manual input
If inputTypeFound = "Manual Input" Then
'For each case
'sets cell to zero
'Prevents manual inputs from being overwritten
If setCell.Interior.ColorIndex <> 36 Then
setCell.Value = 0
'Otherwise set it yellow, unlock, black font
setCell.Interior.ColorIndex = 36
setCell.Locked = False
setCell.Font.ColorIndex = 1
End If
'if its cyclelink input
Else
'set the value equal to the max case value from the cyclelink tab
setCell.Value = cyclelinkValue(i, m)
'set it green, locked, and black font
setCell.Interior.ColorIndex = 35
setCell.Locked = True
setCell.Font.ColorIndex = 1
End If
'If there are no more cells to check, end loop
If thingsToSet(i, m + 1) = "" Then
Exit For
End If
Next m
If checkWkshtName(i + 1) = "" Then
Exit For
End If
Next i
Exit Sub
NotFoundWhatToCheck:
MsgBox whatToCheck(i, j)
Resume Next
NotFoundThingsToSet:
MsgBox thingsToSet(i, m)
Resume Next
End Sub
Sub maxCOcatalystValue()
Dim i As Integer, j As Integer, whatToSet(10, 50) As String, targetCellLocation(10, 50, 50), linkValue(0, 50, 50)
Dim category As String, wkshtName As String, formulaWkshtName(10) As String, formulaCell As Range, k As Integer
Dim targetValue(10, 50, 50), lCount As Long, numrepeats As Integer, n As Integer, P As Integer, m As Integer
Dim catalystExitValue(50) As Double, reductionFactorCO As Double, maxCOatStack As Double, actualO2Dry(50) As Double
Dim saveWkshtName(10) As String, whatToSave(10) As String, saveCell As Range, firstThingsToSet(10, 50) As String
Dim catalystExitCell(50), COcatalystInletValues(50) As Double, h As Integer, secondThingsToSet(10, 50) As String
Dim toCheckWkshtName(10), toSetWkshtName(10), whatToCheck(10, 50), checkCell As Range, setCell As Range
Dim curMaxValue(10, 50) As Double, curMaxCaseNum As Integer, coHRSGStackCell As Range
'Define worksheets to be used and what values need to be found and set
saveWkshtName(0) = "General Inputs"
whatToSave(0) = "Maximum CO Permitted at Stack"
saveWkshtName(1) = "Emissions Calculation"
whatToSave(1) = "ACTUAL STACK O2, DRY"
toSetWkshtName(0) = "Emissions Calculation"
firstThingsToSet(0, 0) = "HRSG STACK CO EMISSION, [EMAIL="ppmvd@15%O2"]ppmvd@15%O2[/EMAIL]"
toCheckWkshtName(0) = "Emissions Calculation"
whatToCheck(0, 0) = "CO Catalyst inlet, ppmvd"
whatToCheck(0, 1) = "CO Catalyst Exit, ppmVd"
secondThingsToSet(0, 0) = "CO Catalyst Reduction Factor"
'turn on automatic calculations
Application.Calculation = xlAutomatic
curMaxCaseNum = 0
'Initial cell to save
Set saveCell = Range("A1")
For m = 0 To 1 Step 1
'activate Worksheet
Worksheets(saveWkshtName(m)).Activate
'Search for cell with the values that need to be saved and offset two cells
With Worksheets(saveWkshtName(m)).UsedRange
On Error GoTo NotFoundWhatToSave
Set saveCell = .Find(What:=whatToSave(m), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'if whattosave is "Maximum CO Permitted at Stack"
If m = 0 Then
'save the max CO at Stack value
maxCOatStack = saveCell.Value
'otherwise if whattosave is "ACTUAL STACK O2, DRY"
ElseIf m = 1 Then
'for every case
For k = 0 To numCases
'save the actual stack o2 dry value to an array
actualO2Dry(k) = saveCell.Offset(0, k).Value
Next k
End If
Next m
'Initial cell to check
Set checkCell = Range("A1")
'Check cell
For i = 0 To 100 Step 1
'activate worksheet
Worksheets(toCheckWkshtName(i)).Activate
'Set the HRSG STACK CO EMISSIONS FACTOR and then update calculations
'Intialize
Set coHRSGStackCell = Range("A1")
'on this worksheet
With Worksheets(toSetWkshtName(i)).UsedRange
'save the location of the firstthingstoset to the coHRSGStackCelll variable
On Error GoTo NotFoundfirstThingsToSet
Set coHRSGStackCell = .Find(What:=firstThingsToSet(i, 0), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'for every case set the max CO at Stack value initially
For k = 0 To numCases Step 1
coHRSGStackCell.Offset(0, k).Select
Selection.Value = maxCOatStack
Next k
'finds the max value of the CO catalyst inlet and all the exit values
For j = 0 To 50 Step 1
'Search for cell to check and offsets 2
With Worksheets(toCheckWkshtName(i)).UsedRange
On Error GoTo NotFoundWhatToCheck
'saves location of whattocheck names to the checkcell variable
Set checkCell = .Find(What:=whatToCheck(i, j), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'initialize current max value to 0
curMaxValue(i, j) = 0
'for every case
For k = 0 To numCases Step 1
'Select Cell and offset by one for each additional case
checkCell.Offset(0, k).Select
'if "CO Catalyst inlet, ppmvd" is whattocheck
If j = 0 Then
'save all its values to an array
COcatalystInletValues(k) = Selection.Value
'if the selection value is greater than the currrent max (need to check at 15% O2 not at actual)
If Selection.Value * (20.9 - 15) / (20.9 - actualO2Dry(k) * 100) >= curMaxValue(i, j) * (20.9 - 15) / (20.9 - actualO2Dry(curMaxCaseNum) * 100) Then
'set it to the max and save the case number
curMaxValue(i, j) = Selection.Value
curMaxCaseNum = k
End If
End If
'if whattocheck is "CO Catalyst Exit, ppmVd" then save all the values to an array
If j = 1 Then
catalystExitValue(k) = Selection.Value
End If
Next k
'If there are no more cells to check, end loop
If whatToCheck(i, j + 1) = "" Then
Exit For
End If
Next j
If maxCOatStack = 0 Or COcatalystInletValues(curMaxCaseNum) < maxCOatStack Then
reductionFactorCO = 0
Else
'MsgBox
'MsgBox curMaxValue(0, 0)
'calculate the reduction factor of the max Case, which will be used for all the cases
reductionFactorCO = 1 - (catalystExitValue(curMaxCaseNum) / curMaxValue(0, 0))
End If
'Intialize the cell that will be set
Set setCell = Range("A1")
'on this worksheet
With Worksheets(toSetWkshtName(i)).UsedRange
'the location of the "CO Catalyst Reduction Factor" will be saved to setcell
On Error GoTo COCatalystError
Set setCell = .Find(What:=secondThingsToSet(i, 0), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'for every case
For k = 0 To numCases Step 1
'offset for each additional case
setCell.Offset(0, k).Select
'the reduction factor will be set
Selection.Value = reductionFactorCO
Next k
'set the co catalyst exit for the other cases
'set the hrsg stack co emissions for the other cases
'Searches for cell to check and offsets 2
With Worksheets(toCheckWkshtName(i)).UsedRange
'find the location of "CO Catalyst Exit, ppmVd" and save it and offset two
On Error GoTo NotFoundWhatToCheck
Set checkCell = .Find(What:=whatToCheck(i, 1), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'for every case
For k = 0 To numCases Step 1
'when the case isnt the current max case
If k <> curMaxCaseNum Then
'set the value of "CO Catalyst Exit, ppmVd" to the formula below
checkCell.Offset(0, k).Select
'CO exit values
Selection.Value = COcatalystInletValues(k) * (1 - reductionFactorCO)
'set the value of "hrsg stack ppmvd @15% o2" to the formula below
'checkCell.Offset(0, k).Select is the catalystexit value
coHRSGStackCell.Offset(0, k).Select
Selection.Value = checkCell.Offset(0, k).Value * ((20.9 - 15) / (20.9 - actualO2Dry(k) * 100))
'restore the formula to all the other adjacent cells
checkCell.Offset(0, k).Select
checkCell.Offset(0, curMaxCaseNum).Copy
ActiveSheet.Paste Destination:=Selection
ElseIf k = curMaxCaseNum Then
If maxCOatStack = 0 Or COcatalystInletValues(curMaxCaseNum) < maxCOatStack Then
coHRSGStackCell.Offset(0, k).Select
Selection.Value = COcatalystInletValues(k) * ((20.9 - 15) / (20.9 - actualO2Dry(k) * 100))
End If
End If
Next k
If toCheckWkshtName(i + 1) = "" Then
Exit For
End If
Next i
'turn off automatic calculations
Application.Calculation = xlManual
Exit Sub
NotFoundWhatToCheck:
'MsgBox whatToCheck(i, j)
Resume Next
NotFoundWhatToSave:
'MsgBox whatToSave(i)
Resume Next
NotFoundfirstThingsToSet:
'MsgBox firstThingsToSet(i, m)
Resume Next
COCatalystError:
'MsgBox "CO Catalyst Program Error"
Resume Next
End Sub
Sub inputType()
Dim i As Integer, j As Integer, k As Integer, offDesignMax As Double, curValue(10, 50, 50) As Double
Dim formulaWkshtName(10) As String, formulaCell As Range, curMaxCase As Double
Dim whatToSet(10, 50) As String, caseNameCell, Q As Integer, caseFound As Boolean
Dim defaultFormula(10, 50, 50), linkValue(0, 50, 50), numrepeats As Integer, lCount As Long
'Definitions of worksheets and things to be set on those respective worksheets
formulaWkshtName(0) = "General Inputs"
whatToSet(0, 0) = "HP Steam Flow"
whatToSet(0, 1) = "CRH Steam Flow"
whatToSet(0, 2) = "Condensate Temperature"
whatToSet(0, 3) = "CRH Steam Flow"
whatToSet(0, 4) = "HRH Steam Flow"
whatToSet(0, 5) = "LP Steam Flow"
whatToSet(0, 6) = "HP Feedwater Flow"
whatToSet(0, 7) = "IP Feedwater Flow"
whatToSet(0, 8) = "Condensate Flow"
whatToSet(0, 9) = "CTG Fuel Flow (each)"
whatToSet(0, 10) = "Duct Burner Fuel Flow (each)"
whatToSet(0, 11) = "HP Drum Pressure"
whatToSet(0, 12) = "IP Drum Pressure"
whatToSet(0, 13) = "LP Drum Pressure"
whatToSet(0, 14) = "HP Superheater Exit Pressure"
whatToSet(0, 15) = "STG Throttle Pressure"
whatToSet(0, 16) = "IP Superheater Exit Pressure"
whatToSet(0, 17) = "CRH Pressure at STG"
whatToSet(0, 18) = "HRH Exit Pressure"
whatToSet(0, 19) = "LP Superheater Exit Pressure"
whatToSet(0, 20) = "Condenser Back Pressure"
whatToSet(0, 21) = "HP Superheater Exit Temperature"
whatToSet(0, 22) = "CRH Temperature at STG"
whatToSet(0, 23) = "HRH Exit Temperature"
whatToSet(0, 24) = "LP Superheater Exit Temperature"
whatToSet(0, 25) = "Ambient Dry Bulb Temperature"
whatToSet(0, 26) = "Ambient Wet Bulb Temperature"
whatToSet(0, 27) = "Ambient Relative Humidity "
whatToSet(0, 28) = "Main Steam Throttle Temperature"
formulaWkshtName(1) = "BFWPump"
whatToSet(1, 0) = "Suction Temperature"
whatToSet(1, 1) = "Suction Pressure"
formulaWkshtName(2) = "Aux Load"
whatToSet(2, 0) = "Gross Output per CTG"
whatToSet(2, 1) = "Gross Output per STG"
whatToSet(2, 2) = "Gas Turbines Running"
whatToSet(2, 3) = "Steam Turbines Running"
'initialize location of cell to store values
Set formulaCell = Range("A1")
' SET VALUES TO CELLS
'Determine if cell should be locked or unlocked and set default value
For i = 0 To 10 Step 1
'Unprotect worksheet
Worksheets(formulaWkshtName(i)).Activate
'Loops through all the cells to be locked or unlocked
For j = 0 To 50 Step 1
'Set off design max to 0
offDesignMax = 0
'Search for cell to lock or unlock and offsets 2
With Worksheets(formulaWkshtName(i)).UsedRange
On Error GoTo NotFound
Set formulaCell = .Find(What:=whatToSet(i, j), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'Repeats actions for adjacent cells
For k = 0 To numCases Step 1
'Select Cell to be modified
formulaCell.Offset(0, k).Select
'Check if the input type to see whats found
'if manual input is found
If inputTypeFound = "Manual Input" Then
'For Design Case
'sets cell to zero
'prevents cells from being overwritten
If Selection.Interior.ColorIndex <> 36 Then
Selection.Value = 0
'Otherwise set it yellow, unlock, black font
Selection.Interior.ColorIndex = 36
Selection.Locked = False
Selection.Font.ColorIndex = 1
'For Off-design max case
'If there is an off design case set the cell to zero
If Selection.Offset(0, 1).Interior.ColorIndex = 35 Or Selection.Offset(0, 1).Interior.ColorIndex = 36 Then
Selection.Offset(0, 1).Value = 0
'Otherwise set it yellow, unlock, black font
Selection.Offset(0, 1).Interior.ColorIndex = 36
Selection.Offset(0, 1).Locked = False
Selection.Offset(0, 1).Font.ColorIndex = 1
End If
End If
'Only needed for k = 0, so exit loop
Exit For
Else
'Find number of times whattoset is repeated in cyclink
numrepeats = WorksheetFunction.CountIf(Worksheets(caseNames(k)).UsedRange, whatToSet(i, j))
'the default value is defined
Set defaultFormula(i, j, k) = Range("A1")
'Go To worksheet with that case name
With Worksheets(caseNames(k)).UsedRange
For lCount = 1 To numrepeats Step 1
On Error GoTo NotFound
Set defaultFormula(i, j, k) = .Find(What:=whatToSet(i, j), After:=defaultFormula(i, j, k), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Chooses the match that isnt excluded from cycle link, denotes by the turquoise color: index 8
If defaultFormula(i, j, k).Offset(0, -5).Interior.ColorIndex <> 8 Then
curValue(i, j, k) = defaultFormula(i, j, k).Offset(0, -1).Value
'exit the loop when the correct value is found
Exit For
End If
Next lCount
End With
'if design case
If k = 0 Then
'set value
Selection.Value = curValue(i, j, k)
'set it to green and locked
Selection.Interior.ColorIndex = 35
Selection.Locked = True
'Color font black
Selection.Font.ColorIndex = 1
End If
'to find the off design max value check the current value vs. the current max
If i = 0 And j = 0 Then
If curValue(i, j, k) > offDesignMax Then
offDesignMax = curValue(i, j, k)
curMaxCase = k
End If
End If
End If
Next k
'After all cases are checked set the off design max value
formulaCell.Offset(0, 1).Select
If inputTypeFound <> "Manual Input" Then
'if the cell is green or yellow or gray
If Selection.Interior.ColorIndex = 35 Or Selection.Interior.ColorIndex = 36 Or Selection.Interior.ColorIndex = 16 Then
'set value
Selection.Value = curValue(i, j, curMaxCase)
'set it to green
Selection.Interior.ColorIndex = 35
'lock the cell
Selection.Locked = True
'Color font black
Selection.Font.ColorIndex = 1
End If
End If
'If there are no more cells to lock/unlock, end loop
If whatToSet(i, j + 1) = "" Then
Exit For
End If
Next j
'If there are no more worksheets to set cells on, end loop
If formulaWkshtName(i + 1) = "" Then
Exit For
End If
Next i
Exit Sub
WrongSpelling:
MsgBox "Check Spelling of " & whatToSet(i, j) & " in code. i=" & i & ", j=" & j & ".", , "Warning"
Resume Next
NotFound:
MsgBox whatToSet(i, j)
Resume Next
End Sub
Sub LockCellIf()
Dim i As Integer, j As Integer, k As Integer, n As Integer, m As Integer, P As Integer, numRules As Integer
Dim equalsPos As Integer, defaultValue(50, 50, 50), matchFound As Boolean, curLockWksht As Worksheet
Dim categories(50, 50) As String, ruleOption(50, 50, 50) As String, ruleWkshtName(50) As String
Dim lockWkshtName(50, 50) As String, whatToLock(50, 50, 50) As String, curRuleWksht As Worksheet
Dim optionFound As Range, lockCell As Range, cellWithValidation(50) As String
'RULES TO DETERMINE LOCKED CELLS
'*****WHEN MAKING RULES DON'T MIX CELLS THAT WILL BE LOCKED THAT USE VALIDATION WITH CELLS THAT DONT
'Rule #0
'On this worksheet: (i)
ruleWkshtName(0) = "General Inputs"
'If this category: (i, m)
categories(0, 0) = "Cooling System"
'contains any of these values: (i, m, n)
ruleOption(0, 0, 0) = "Air Cooled Condenser"
'Then on this worksheet: (i, j)
lockWkshtName(0, 0) = "General Inputs"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(0, 0, 0) = "CW Flow Rate"
'Then on this worksheet: (i, j)
lockWkshtName(0, 1) = "Equipment List"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(0, 1, 0) = "Circulating Water Pumps"
'Then on this worksheet: (i, j)
lockWkshtName(0, 2) = "Perf. Summary"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(0, 2, 0) = "CW Flow Rate"
whatToLock(0, 2, 1) = "CW Temp at Inlet to Condenser"
whatToLock(0, 2, 2) = "Cooling Tower Range"
whatToLock(0, 2, 3) = "Condenser TTD"
'If any of the cells to be locked use validation
cellWithValidation(0) = "No"
'Rule #1
'On this worksheet: (i)
ruleWkshtName(1) = "General Inputs"
'If this category: (i, m)
categories(1, 0) = "Type of HRSG"
'contains any of these values: (i, m, n)
ruleOption(1, 0, 0) = "Single Pressure (HP)"
ruleOption(1, 0, 1) = "Two Pressure (HP - LP)"
'Then on this worksheet: (i, j)
lockWkshtName(1, 0) = "General Inputs"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(1, 0, 0) = "IP Feedwater Flow"
whatToLock(1, 0, 1) = "HRH Steam Flow"
whatToLock(1, 0, 2) = "CRH Steam Flow"
whatToLock(1, 0, 3) = "IP Drum Pressure"
whatToLock(1, 0, 4) = "HRH Exit Pressure"
whatToLock(1, 0, 5) = "HRH Exit Temperature"
whatToLock(1, 0, 6) = "IP Superheater Exit Pressure"
whatToLock(1, 0, 7) = "CRH Temperature at STG"
whatToLock(1, 0, 8) = "CRH Pressure at STG"
'Then on this worksheet: (i, j)
lockWkshtName(1, 1) = "BFWPump"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(1, 1, 0) = "IP Flow Rating"
whatToLock(1, 1, 1) = "IP Total Developed Head"
whatToLock(1, 1, 2) = "IP Tap Flow (mass)"
whatToLock(1, 1, 3) = "IP Flow with 5% Margin"
whatToLock(1, 1, 4) = "IP Flow per pump"
whatToLock(1, 1, 5) = "IP Sp. Volume of Water"
whatToLock(1, 1, 6) = "IP Tap Flow (volume)"
whatToLock(1, 1, 7) = "IP Superheater Exit Pressure"
whatToLock(1, 1, 8) = "IP Superheater Pressure Loss"
whatToLock(1, 1, 9) = "IP Drum Operating Pressure"
whatToLock(1, 1, 10) = "IP LCV Loss"
defaultValue(1, 1, 10) = 30
whatToLock(1, 1, 11) = "IP Economizer Pressure Loss"
defaultValue(1, 1, 11) = 40
whatToLock(1, 1, 12) = "IP Economizer Inlet Pressure"
whatToLock(1, 1, 13) = "IP LCV Inlet Elevation"
defaultValue(1, 1, 13) = 95
whatToLock(1, 1, 14) = "IP Pipe and Valve Loss"
defaultValue(1, 1, 14) = 7.5
whatToLock(1, 1, 15) = "IP Discharge Pressure"
whatToLock(1, 1, 16) = "IP Discharge Head"
whatToLock(1, 1, 17) = "IP Flow Per Pump"
whatToLock(1, 1, 17) = "Total IP Head"
whatToLock(1, 1, 18) = "IP Margin for Control - Discharge"
whatToLock(1, 1, 19) = "IP Margin for Control - Suction"
whatToLock(1, 1, 20) = "Pump IP TDH"
whatToLock(1, 1, 21) = "Pump IP TDH in Metric"
whatToLock(1, 1, 22) = "IP Flow per Pump "
whatToLock(1, 1, 23) = "IP Flow per Pump in Metric"
whatToLock(1, 1, 24) = "IP TDH"
whatToLock(1, 1, 25) = "IP TDH in Metric"
'Then on this worksheet: (i, j)
lockWkshtName(1, 2) = "PFD"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(1, 2, 0) = "HRH Steam Flow"
whatToLock(1, 2, 1) = "HRH Exit Pressure"
whatToLock(1, 2, 2) = "HRH Exit Temperature"
whatToLock(1, 2, 3) = "CRH Steam Flow"
whatToLock(1, 2, 4) = "CRH Pressure at STG"
whatToLock(1, 2, 5) = "CRH Temperature at STG"
'Then on this worksheet: (i, j)
lockWkshtName(1, 3) = "Perf. Summary"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(1, 3, 0) = "Hot Reheat Throttle Temperature"
whatToLock(1, 3, 1) = "Hot Reheat Steam Throttle Flow"
whatToLock(1, 3, 2) = "IP Pinch"
whatToLock(1, 3, 3) = "Hot Reheat Piping pressure drop"
whatToLock(1, 3, 4) = "HP / HRH Throttle Temperature"
whatToLock(1, 3, 5) = "HP / IP / LP Pinch"
whatToLock(1, 3, 6) = "Cold Reheat Steam Flow"
'Then on this worksheet: (i, j)
lockWkshtName(1, 4) = "Bypass DSH"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(1, 4, 0) = "HRH Steam Flow"
whatToLock(1, 4, 1) = "HRH Exit Pressure"
whatToLock(1, 4, 2) = "HRH Exit Temperature"
whatToLock(1, 4, 3) = "HRH Steam Enthalpy"
whatToLock(1, 4, 4) = "Desired HRH Bypass Steam Pressure"
defaultValue(1, 4, 4) = "40"
whatToLock(1, 4, 5) = "Desired HRH Bypass Steam Degrees Superheat"
defaultValue(1, 4, 5) = "5"
whatToLock(1, 4, 6) = "Desired HRH Bypass Saturation Temperature"
whatToLock(1, 4, 7) = "Desired HRH Bypass Steam Temperature"
whatToLock(1, 4, 8) = "Desired HRH Bypass Steam Enthalpy"
whatToLock(1, 4, 9) = "HRH Spray Water Pressure"
defaultValue(1, 4, 9) = "200"
whatToLock(1, 4, 10) = "HRH Spray Water Temperature"
defaultValue(1, 4, 10) = "100"
whatToLock(1, 4, 11) = "HRH Spray Water Enthalpy "
whatToLock(1, 4, 12) = "HRH Spray Water Quantity "
whatToLock(1, 4, 13) = "Total Bypass Flow "
'If any of the cells to be locked use validation
cellWithValidation(1) = "No"
'Rule #2
'On this worksheet: (i)
ruleWkshtName(2) = "General Inputs"
'If this category: (i, m)
categories(2, 0) = "Type of HRSG"
'contains any of these values: (i, m, n)
ruleOption(2, 0, 0) = "Single Pressure (HP)"
'Then on this worksheet: (i, j)
lockWkshtName(2, 0) = "General Inputs"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(2, 0, 0) = "LP Steam Flow"
whatToLock(2, 0, 1) = "LP Drum Pressure"
whatToLock(2, 0, 2) = "LP Superheater Exit Pressure"
whatToLock(2, 0, 3) = "LP Superheater Exit Temperature"
'Then on this worksheet: (i, j)
lockWkshtName(2, 1) = "CondPump"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(2, 1, 0) = "Calculated TDH"
whatToLock(2, 1, 1) = "Calculated Pump TDH"
whatToLock(2, 1, 2) = "Calculated Pump TDH (metric)"
whatToLock(2, 1, 3) = "LP Drum Pressure"
whatToLock(2, 1, 4) = "LP Drum LCV Pressure Drop"
defaultValue(2, 1, 4) = 30
whatToLock(2, 1, 5) = "Economizer Pressure Drop"
defaultValue(2, 1, 5) = 25
whatToLock(2, 1, 6) = "Required Pressure at Economizer Inlet"
whatToLock(2, 1, 7) = "Pressure Requirement @ Bypass Valve Attemperator"
whatToLock(2, 1, 8) = "Higher of Econ. Inlet and Bypass Valve Attemperator Pressure"
whatToLock(2, 1, 9) = "GSC Pressure Drop"
defaultValue(2, 1, 9) = 5.5
whatToLock(2, 1, 10) = "Cond Polisher Drop"
whatToLock(2, 1, 11) = "Condensate Piping Losses"
defaultValue(2, 1, 11) = 11.5
whatToLock(2, 1, 12) = "Margin for control"
whatToLock(2, 1, 13) = "LP Drum Inlet elevation"
defaultValue(2, 1, 13) = 95
whatToLock(2, 1, 14) = "Pump Discharge Elevation"
whatToLock(2, 1, 15) = "Total Pump Disch Pressure"
'Then on this worksheet: (i, j)
lockWkshtName(2, 2) = "PFD"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(2, 2, 0) = "LP Steam Flow"
whatToLock(2, 2, 1) = "LP Superheater Exit Pressure"
whatToLock(2, 2, 2) = "LP Superheater Exit Temperature"
'Then on this worksheet: (i, j)
lockWkshtName(2, 3) = "Perf. Summary"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(2, 3, 0) = "LP Turbine Steam Flow"
whatToLock(2, 3, 1) = "LP Pinch"
whatToLock(2, 3, 2) = "HP / LP Pinch"
'Then on this worksheet: (i, j)
lockWkshtName(2, 4) = "Bypass DSH"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(2, 4, 0) = "LP Steam Flow"
whatToLock(2, 4, 1) = "LP Superheater Exit Pressure"
whatToLock(2, 4, 2) = "LP Superheater Exit Temperature"
whatToLock(2, 4, 3) = "LP Steam Enthalpy"
whatToLock(2, 4, 4) = "Desired LP Bypass Steam Pressure"
defaultValue(2, 4, 4) = "25"
whatToLock(2, 4, 5) = "Desired LP Bypass Steam Degrees Superheat"
defaultValue(2, 4, 5) = "20"
whatToLock(2, 4, 6) = "Desired LP Bypass Saturation Temperature"
whatToLock(2, 4, 7) = "Desired LP Bypass Steam Temperature"
whatToLock(2, 4, 8) = "Desired LP Bypass Steam Enthalpy"
whatToLock(2, 4, 9) = "LP Spray Water from Condensate Pressure"
whatToLock(2, 4, 10) = "LP Spray Water from Condensate Temperature"
whatToLock(2, 4, 11) = "LP Spray Water Enthalpy"
whatToLock(2, 4, 12) = "LP Spray Water Quantity"
whatToLock(2, 4, 13) = "Total Bypass Flow"
'If any of the cells to be locked use validation
cellWithValidation(2) = "No"
'Rule #3
'On this worksheet: (i)
ruleWkshtName(3) = "General Inputs"
'If this category: (i, m)
categories(3, 0) = "SCR"
'contains any of these values: (i, m, n)
ruleOption(3, 0, 0) = "No SCR"
'Then on this worksheet: (i, j)
lockWkshtName(3, 0) = "General Inputs"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(3, 0, 0) = "Concentration of NH3 in Solution"
defaultValue(3, 0, 0) = 0.19
whatToLock(3, 0, 1) = "Ammonia Slip"
defaultValue(3, 0, 1) = 8
whatToLock(3, 0, 2) = "Maximum NOx Permitted at Stack"
defaultValue(3, 0, 2) = 2.5
'Then on this worksheet: (i, j)
lockWkshtName(3, 1) = "Ammonia"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(3, 1, 0) = "Ammonia Storage Tank Storage Time"
whatToLock(3, 1, 1) = "Ammonia Storage Tank Size"
whatToLock(3, 1, 2) = "Ammonia Pump Size"
whatToLock(3, 1, 3) = "Quantity of Ammonia Tanks"
'If any of the cells to be locked use validation
cellWithValidation(3) = "No"
'Rule #4
'On this worksheet: (i)
ruleWkshtName(4) = "General Inputs"
'If this category: (i, m)
categories(4, 0) = "Cooling System"
'contains any of these values: (i, m, n)
ruleOption(4, 0, 0) = "Once Through Condenser"
ruleOption(4, 0, 1) = "Air Cooled Condenser"
'Then on this worksheet: (i, j)
lockWkshtName(4, 0) = "General Inputs"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(4, 0, 0) = "Cooling Tower Duty "
'Then on this worksheet: (i, j)
lockWkshtName(4, 1) = "Perf. Summary"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(4, 1, 0) = "Approach Temperature"
whatToLock(4, 1, 1) = "Cooling Tower Evaporation Loss"
whatToLock(4, 1, 2) = "Cooling Tower Blowdown(2)"
whatToLock(4, 1, 3) = "Cycle Makeup Water"
'If any of the cells to be locked use validation
cellWithValidation(4) = "No"
'Rule #5
'On this worksheet: (i)
ruleWkshtName(5) = "General Inputs"
'If this category: (i, m)
categories(5, 0) = "CO Catalyst"
'contains any of these values: (i, m, n)
ruleOption(5, 0, 0) = "No CO Catalyst"
ruleOption(5, 0, 1) = "Space for Future CO Catalyst"
'Then on this worksheet: (i, j)
lockWkshtName(5, 0) = "General Inputs"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(5, 0, 0) = "Maximum CO Permitted at Stack"
'If any of the cells to be locked use validation
cellWithValidation(5) = "No"
'Rule #6
'On this worksheet: (i)
ruleWkshtName(6) = "FuelGas"
'If this category: (i, m)
categories(6, 0) = "Calculation Method"
'contains any of these values: (i, m, n)
ruleOption(6, 0, 0) = "Volume Basis"
ruleOption(6, 0, 1) = "Mass Basis"
'Then on this worksheet: (i, j)
lockWkshtName(6, 0) = "FuelGas"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(6, 0, 0) = "NG Heating Value"
defaultValue(6, 0, 0) = 23892
whatToLock(6, 0, 1) = "HHV/LHV Ratio"
defaultValue(6, 0, 1) = 1.109
whatToLock(6, 0, 2) = "HHV/LHV"
defaultValue(6, 0, 2) = "HHV"
'If any of the cells to be locked use validation
cellWithValidation(6) = "No"
'Rule #7
'On this worksheet: (i)
ruleWkshtName(7) = "FuelGas"
'If this category: (i, m)
categories(7, 0) = "Calculation Method"
'contains any of these values: (i, m, n)
ruleOption(7, 0, 0) = "Direct Input"
'Then on this worksheet: (i, j)
lockWkshtName(7, 0) = "FuelGas"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(7, 0, 1) = "METHANE"
defaultValue(7, 0, 1) = 1
whatToLock(7, 0, 2) = "ETHANE"
whatToLock(7, 0, 3) = "PROPANE"
whatToLock(7, 0, 4) = "ISOBUTANE"
whatToLock(7, 0, 5) = "N-BUTANE"
whatToLock(7, 0, 6) = "ISOPENTANE"
whatToLock(7, 0, 7) = "N-PENTANE"
whatToLock(7, 0, 8) = "HEXANE"
whatToLock(7, 0, 9) = "HEPTANE"
whatToLock(7, 0, 10) = "OCTANE"
whatToLock(7, 0, 11) = "NONANE"
whatToLock(7, 0, 12) = "N-DECANE"
whatToLock(7, 0, 13) = "BENZENE"
whatToLock(7, 0, 14) = "TOLUENE"
whatToLock(7, 0, 15) = "CARBON DIOXIDE "
whatToLock(7, 0, 16) = "CARBON MONOXIDE"
whatToLock(7, 0, 17) = "NITROGEN "
whatToLock(7, 0, 18) = "HYDROGEN "
whatToLock(7, 0, 19) = "HYDROGEN SULFIDE"
whatToLock(7, 0, 20) = "SULFUR"
whatToLock(7, 0, 21) = "ARGON "
whatToLock(7, 0, 22) = "WATER VAPOR"
whatToLock(7, 0, 23) = "OXYGEN "
whatToLock(7, 0, 24) = "TOTAL"
'If any of the cells to be locked use validation
cellWithValidation(7) = "No"
'Rule #8
'On this worksheet: (i)
ruleWkshtName(8) = "H2OTreatment"
'If this category: (i, m)
categories(8, 0) = "Raw/Fire Water Storage Tank"
'contains any of these values: (i, m, n)
ruleOption(8, 0, 0) = "No"
'Then on this worksheet: (i, j)
lockWkshtName(8, 0) = "H2OTreatment"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(8, 0, 0) = "Raw/Fire Water Tank Storage Time"
defaultValue(8, 0, 0) = 48
whatToLock(8, 0, 1) = "Maximum Raw Water Flow into Tank"
whatToLock(8, 0, 2) = "RW Tank Capacity"
whatToLock(8, 0, 3) = "RW Tank Diameter"
whatToLock(8, 0, 4) = "RW Tank Height"
whatToLock(8, 0, 5) = "Raw Water Capacity Required"
'If any of the cells to be locked use validation
cellWithValidation(8) = "No"
'Rule #9
'On this worksheet: (i)
ruleWkshtName(9) = "H2OTreatment"
'If this category: (i, m)
categories(9, 0) = "Raw/Fire Water Storage Tank"
'contains any of these values: (i, m, n)
ruleOption(9, 0, 0) = "No"
'Then on this worksheet: (i, j)
lockWkshtName(9, 0) = "H2OTreatment"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(9, 0, 0) = "Required Fire Water Storage - 2 hrs Storage"
whatToLock(9, 0, 1) = "Fire Water Storage Time"
defaultValue(9, 0, 1) = 2
'If any of the cells to be locked use validation
cellWithValidation(9) = "No"
'Rule #10
'On this worksheet: (i)
ruleWkshtName(10) = "H2OTreatment"
'If this category: (i, m)
categories(10, 0) = "Demineralized Water Storage Tank"
'contains any of these values: (i, m, n)
ruleOption(10, 0, 0) = "No"
'Then on this worksheet: (i, j)
lockWkshtName(10, 0) = "H2OTreatment"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(10, 0, 0) = "Demineralized Water Tank Storage Time"
defaultValue(10, 0, 0) = 24
whatToLock(10, 0, 1) = "Maximum Demineralized Water Flow into Tank "
whatToLock(10, 0, 2) = "DW Capacity Required"
whatToLock(10, 0, 3) = "DW Tank Capacity"
whatToLock(10, 0, 4) = "DW Tank Diameter"
whatToLock(10, 0, 5) = "DW Tank Height"
'If any of the cells to be locked use validation
cellWithValidation(10) = "No"
'Rule #11
'On this worksheet: (i)
ruleWkshtName(11) = "General Inputs"
'If this category: (i, m)
categories(11, 0) = "Duct Burner"
'contains any of these values: (i, m, n)
ruleOption(11, 0, 0) = "Unfired"
'Then on this worksheet: (i, j)
lockWkshtName(11, 0) = "General Inputs"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(11, 0, 0) = "Duct Burner Fuel Flow (each)"
'Then on this worksheet: (i, j)
lockWkshtName(11, 1) = "PFD"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(11, 1, 0) = "Duct Burner Fuel Flow (each)"
'Then on this worksheet: (i, j)
lockWkshtName(11, 2) = "Perf. Summary"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(11, 2, 0) = "Duct Burner Fuel Flow (each)"
whatToLock(11, 2, 1) = "DB Fuel Consumption (HHV)"
whatToLock(11, 2, 1) = "DB Outlet temperature"
'If any of the cells to be locked use validation
cellWithValidation(11) = "No"
'Rule #12
'On this worksheet: (i)
ruleWkshtName(12) = "General Inputs"
'If this category: (i, m)
categories(12, 0) = "Power Augmentation"
'contains any of these values: (i, m, n)
ruleOption(12, 0, 0) = "None"
'Then on this worksheet: (i, j)
lockWkshtName(12, 0) = "Perf. Summary"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(12, 0, 0) = "CTG Steam/Water Injection"
'If any of the cells to be locked use validation
cellWithValidation(12) = "No"
'Rule #13
'On this worksheet: (i)
ruleWkshtName(13) = "General Inputs"
'If this category: (i, m)
categories(13, 0) = "Closed Cooling"
'contains any of these values: (i, m, n)
ruleOption(13, 0, 0) = "Air Cooled"
'Then on this worksheet: (i, j)
lockWkshtName(13, 0) = "CCW"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(13, 0, 0) = "CTG Generator Cooler (s)"
whatToLock(13, 0, 1) = "CTG Lube Oil Cooler (s)"
whatToLock(13, 0, 2) = "ST Generator Cooler (s)"
whatToLock(13, 0, 3) = "ST Lube Oil Cooler (s)"
whatToLock(13, 0, 4) = "Boiler Feedwater Pump Coolers"
whatToLock(13, 0, 5) = "Miscellaneous"
whatToLock(13, 0, 6) = "Margin on flow due to varying temperature rise (15%)"
whatToLock(13, 0, 7) = "Total"
whatToLock(13, 0, 8) = "CCW Pump Flow"
whatToLock(13, 0, 9) = "Closed Cooling Water Pumps"
whatToLock(13, 0, 10) = "Additional Equipment"
'If any of the cells to be locked use validation
cellWithValidation(13) = "No"
'Rule #14
'On this worksheet: (i)
ruleWkshtName(14) = "CompressedAir"
'If this category: (i, m)
categories(14, 0) = "Compressed Air System"
'contains any of these values: (i, m, n)
ruleOption(14, 0, 0) = "No"
'Then on this worksheet: (i, j)
lockWkshtName(14, 0) = "CompressedAir"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(14, 0, 0) = "Air Compressor System"
whatToLock(14, 0, 1) = "Instrument Air Dryer"
whatToLock(14, 0, 2) = "Service/Instrument Air Receiver"
'If any of the cells to be locked use validation
cellWithValidation(14) = "No"
'Rule #15
'On this worksheet: (i)
ruleWkshtName(15) = "General Inputs"
'If this category: (i, m)
categories(15, 0) = "Cooling System"
'contains any of these values: (i, m, n)
ruleOption(15, 0, 0) = "Air Cooled Condenser"
ruleOption(15, 0, 1) = "Wet Cooling Tower"
'Then on this worksheet: (i, j)
lockWkshtName(15, 0) = "Equipment List"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(15, 0, 0) = "Screen Wash Pumps"
'If any of the cells to be locked use validation
cellWithValidation(15) = "No"
'Rule #16
'On this worksheet: (i)
ruleWkshtName(16) = "Aux Load"
'If this category: (i, m)
categories(16, 0) = "Calculate or Input Auxilary Load Percentage"
'contains any of these values: (i, m, n)
ruleOption(16, 0, 0) = "Calculate"
'Then on this worksheet: (i, j)
lockWkshtName(16, 0) = "Aux Load"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(16, 0, 0) = "Auxiliary Load Percentage of Gross Power"
'If any of the cells to be locked use validation
cellWithValidation(16) = "No"
'Rule #17
'On this worksheet: (i)
ruleWkshtName(17) = "General Inputs"
'If this category: (i, m)
categories(17, 0) = "Inlet Cooling"
'contains any of these values: (i, m, n)
ruleOption(17, 0, 0) = "None"
'Then on this worksheet: (i, j)
lockWkshtName(17, 0) = "Perf. Summary"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(17, 0, 0) = "Inlet Cooling Water Consumption"
'If any of the cells to be locked use validation
cellWithValidation(17) = "No"
'Rule #18
'On this worksheet: (i)
ruleWkshtName(18) = "General Inputs"
'If this category: (i, m)
categories(18, 0) = "Closed Cooling"
'contains any of these values: (i, m, n)
ruleOption(18, 0, 0) = "Fin Fan Cooler"
ruleOption(18, 0, 1) = "Wet SAC"
ruleOption(18, 0, 2) = "Air Cooled"
ruleOption(18, 0, 3) = "Once Through"
'Then on this worksheet: (i, j)
lockWkshtName(18, 0) = "Equipment List"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(18, 0, 0) = "Auxiliary Cooling Water Pump"
'If any of the cells to be locked use validation
cellWithValidation(18) = "No"
'Rule #19
'On this worksheet: (i)
ruleWkshtName(19) = "General Inputs"
'If this category: (i, m)
categories(19, 0) = "Cooling System"
'contains any of these values: (i, m, n)
ruleOption(19, 0, 0) = "Once Through Condenser"
ruleOption(19, 0, 1) = "Air Cooled Condenser"
'Or If this category: (i, m)
categories(19, 1) = "Closed Cooling"
'contains any of these values: (i, m, n)
ruleOption(19, 1, 0) = "Once Through"
ruleOption(19, 1, 1) = "Air Cooled"
'Then on this worksheet: (i, j)
lockWkshtName(19, 0) = "CCW"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(19, 0, 0) = "Closed Cooling Water Heat Exchanger"
whatToLock(19, 0, 1) = "CCW Heat Exchanger"
'If any of the cells to be locked use validation
cellWithValidation(19) = "No"
'Rule #20
'On this worksheet: (i)
ruleWkshtName(20) = "General Inputs"
'If this category: (i, m)
categories(20, 0) = "Input Type"
'contains any of these values: (i, m, n)
ruleOption(20, 0, 0) = ""
'Then on this worksheet: (i, j)
lockWkshtName(20, 0) = "General Inputs"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(20, 0, 0) = "CTG Exhaust Flow"
whatToLock(20, 0, 1) = "HP Feedwater Flow"
'Then on this worksheet: (i, j)
lockWkshtName(20, 1) = "BFWPump"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(20, 1, 0) = "Suction Temperature"
whatToLock(20, 1, 1) = "Suction Pressure"
'If any of the cells to be locked use validation
cellWithValidation(20) = "No"
'Rule #21
'On this worksheet: (i)
ruleWkshtName(21) = "General Inputs"
'If this category: (i, m)
categories(21, 0) = "Condenser Air Removal"
'contains any of these values: (i, m, n)
ruleOption(21, 0, 0) = "Steam Jet Air Ejectors"
'Then on this worksheet: (i, j)
lockWkshtName(21, 0) = "Equipment List"
'Lock these cells, Set default value for when the cell is unlocked, this will overwrite existing any formulas if defined: (i, j, k)
whatToLock(21, 0, 0) = "Vacuum Pumps"
'*******************************************
'Number of Rules (Highest Rule number + 1)
numRules = 22
'*************************************
'Initialize option found Range
Set optionFound = Range("A1")
Set lockCell = Range("A1")
'Loop for each rule
For i = 0 To numRules - 1 Step 1
'activate worksheet
Worksheets(ruleWkshtName(i)).Activate
'Resets to default no rule matches found for the next cell to be check for locking or unlocking
matchFound = False
'Loop for different catergories within a rule
For m = 0 To 100 Step 1
'Search for option selected by user
With Worksheets(ruleWkshtName(i)).UsedRange
Set optionFound = .Find(What:=categories(i, m), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 1)
End With
'Check if the rule matches whats found
For n = 0 To 100 Step 1
If optionFound = ruleOption(i, m, n) Then
'Sets matchFound to true for this cell so additional rule options do not overwrite the cell
matchFound = True
End If
'If there are no more rule conditions to check, end for loop
If ruleOption(i, m, n + 1) = "" Then
Exit For
End If
Next n
'If there are no more rule categories to check, end for loop
If categories(i, m + 1) = "" Then
Exit For
End If
Next m
'Determine if cell should be locked or unlocked and set default value or to 0
For j = 0 To 100 Step 1
'activate worksheet
Worksheets(lockWkshtName(i, j)).Activate
'Loops through all the cells to be locked or unlocked
For k = 0 To 100 Step 1
'Search for cell to lock or unlock and offsets 2
With Worksheets(lockWkshtName(i, j)).UsedRange
On Error GoTo WrongSpelling
Set lockCell = .Find(What:=whatToLock(i, j, k), After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Offset(0, 2)
End With
'Repeats actions for adjacent cells
P = 0
Do While lockCell.Offset(0, P).Interior.ColorIndex = 35 Or lockCell.Offset(0, P).Interior.ColorIndex = 36 Or lockCell.Offset(0, P).Interior.ColorIndex = 16
'Select Cell
lockCell.Offset(0, P).Select
equalsPos = 0
'equalsPos = 0 --->>> number
'equalsPos = 1 --->>> formula
'equalsPos = 2 --->>> validation
'Checks to make sure the cell doesnt contain validation, sets to 2 if it does
'Used only to check validation, if a rule has a cell with validation and an i = and or statements
'Otherwise this code slows down the program noticeably
If cellWithValidation(i) = "Yes" Then
On Error Resume Next
If Range(Selection.Address, Selection.Offset(0, 1).Address).SpecialCells(xlCellTypeAllValidation).Count > 0 Then
equalsPos = 2
End If
End If
'Determine if the cell contains a formula only when its isnt yellow, returns 1 if formula, 0 if number
If equalsPos = 0 And Selection.Interior.ColorIndex <> 36 Then
equalsPos = InStr(Selection.Formula, "=")
End If
'If the rule condition was met then gray out the cell and set it equal to zero if there isn't a formula in it
If matchFound = True Then
'if the cell isn't a cell with a formula, set it equal to 0
If equalsPos = 0 Then
Selection.Value = 0
End If
'Lock the Cell
Selection.Locked = True
'Gray Out the Cell
Selection.Interior.ColorIndex = 16
Selection.Font.ColorIndex = 16
'If no match to the rule was found then the cell will not be grayed out
ElseIf matchFound = False Then
'If the default value is defined, set it the cell
'if there isnt a formula in the cell
If equalsPos = 0 Then
'if a default value is defined, and the value of the cell eqauls = 0
If defaultValue(i, j, k) <> 0 And Selection.Value = 0 Then
'Set the default value
Selection.Value = defaultValue(i, j, k)
'Unlock Cell
Selection.Locked = False
End If
End If
'if the cell has a formula, set it to green
If equalsPos = 1 Then
Selection.Interior.ColorIndex = 35
Selection.Locked = True
'If it was gray set it yellow
ElseIf Selection.Interior.ColorIndex = 16 Or equalsPos = 2 Then
Selection.Interior.ColorIndex = 36
'Unlock Cell
Selection.Locked = False
'Otherwise do nothing
End If
'Color font black
Selection.Font.ColorIndex = 1
End If
'Adds 1 to p so the next cell offset of lockCell will be checked if it is yellow or green
P = P + 1
Loop
'If there are no more cells to lock/unlock, end for loop
If whatToLock(i, j, k + 1) = "" Then
Exit For
End If
Next k
'If there are no more worksheets to lock cells on, end for loop
If lockWkshtName(i, j + 1) = "" Then
Exit For
End If
Next j
Next i
Exit Sub
WrongSpelling:
MsgBox "Check Spelling of " & whatToLock(i, j, k) & " in code. i=" & i & ", j=" & j & ", k=" & k & ".", , "Warning"
Resume Next
End Sub
Sub unlockYellowCells()
Dim numWkshts As Integer, lastRow As Integer, lastCol As Integer, r As Integer, c As Integer
For numWkshts = 15 To 1 Step -1
Worksheets(numWkshts).Activate
Worksheets(numWkshts).Unprotect
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
lastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For r = lastRow To 1 Step -1
For c = lastCol To 1 Step -1
Worksheets(numWkshts).UsedRange.Cells(r, c).Select
If Selection.Interior.ColorIndex = 36 Or Selection.Interior.ColorIndex = 2 Or Selection.Font.ColorIndex = 3 Then
Selection.Locked = False
Else
Selection.Locked = True
End If
Next c
Next r
Cells(1, 1).Activate
Next numWkshts
End Sub
Sub lockGreenCells()
Dim numWkshts As Integer, lastRow As Integer, lastCol As Integer, r As Integer, c As Integer
Worksheets("Aux Load").Activate
Worksheets("Aux Load").Unprotect
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
lastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For r = lastRow To 1 Step -1
For c = lastCol To 1 Step -1
Worksheets("Aux Load").UsedRange.Cells(r, c).Select
If Selection.Interior.ColorIndex = 36 Then
Selection.Locked = False
Else
Selection.Locked = True
End If
Next c
Next r
Cells(1, 1).Activate
End Sub
Sub HideRowsOnPerfSummary()
Dim r As Long, lastRow As Long, c As Long, blankRow As Long, firstRow, i, j, wkshtName As String
wkshtName = "Perf. Summary"
Worksheets(wkshtName).Activate
Dim nextUnhiddenRow
On Error Resume Next
Application.ScreenUpdating = False
ActiveSheet.Unprotect
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
For r = lastRow To 1 Step -1
If Cells(r, 4).Interior.ColorIndex = 16 Then
Rows(r).EntireRow.Hidden = True
ActiveSheet.CheckBoxes("CheckBox" & 1 & r).Visible = False
End If
If Cells(r, 1).Value <> True And (Cells(r, 4).Interior.ColorIndex = 35 Or Cells(r, 4).Interior.ColorIndex = 36) Then
Rows(r).EntireRow.Hidden = True
ActiveSheet.CheckBoxes("CheckBox" & 1 & r).Visible = False
End If
Next r
ActiveSheet.Protect
End Sub
Sub unhideRowsOnPerfSummary()
Dim r As Long, lastRow As Long, c As Long, blankRow As Long, firstRow, i, j, wkshtName As String
wkshtName = "Perf. Summary"
Worksheets(wkshtName).Activate
On Error Resume Next
Application.ScreenUpdating = False
ActiveSheet.Unprotect
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
For r = lastRow To 1 Step -1
If Rows(r).EntireRow.Hidden = True Then
Rows(r).EntireRow.Hidden = False
ActiveSheet.CheckBoxes("CheckBox" & 1 & r).Visible = True
End If
Next r
ActiveSheet.Protect
End Sub
Sub HideRowsOnAuxLoad()
Call UnhideRows
Dim r As Long, lastRow As Long, c As Long, blankRow As Long, firstRow, i, j, c1
Dim nextUnhiddenRow
Application.ScreenUpdating = False
ActiveSheet.Unprotect
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
c = 4
c1 = 7
For r = lastRow To 1 Step -1
If Cells(r, c) = "Not Used" Or Cells(r, c1) = "Not Used" Then
Rows(r).EntireRow.Hidden = True
End If
If Cells(r, c1) = "Not Used" And Cells(r, c1).Interior.ColorIndex = 37 Then
Rows(r).EntireRow.Hidden = True
i = r + 1
Do While Cells(i, c1).Interior.ColorIndex <> 37
Rows(i).EntireRow.Hidden = True
i = i + 1
Loop
End If
Next r
ActiveSheet.Protect
End Sub
Sub UnhideRows()
Dim r As Long, lastRow As Long
Application.ScreenUpdating = False
ActiveSheet.Unprotect
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
For r = lastRow To 2 Step -1
If Rows(r).EntireRow.Hidden = True Then
Rows(r).EntireRow.Hidden = False
End If
Next r
ActiveSheet.Protect
End Sub
'*** Must Use at 100% zoom for good alignment***
Sub AddCheckBoxesPerfSummary()
Application.ScreenUpdating = False
On Error Resume Next
Dim c As Range, myRange As Range, zoomLevel As Double, defaultValue As Integer, wkshtName As String
wkshtName = "Perf. Summary"
Worksheets(wkshtName).Activate
'zoomLevel = ActiveWindow.Zoom
'ActiveWindow.Zoom = 100
Set myRange = Selection
For Each c In myRange.Cells
If myRange.Value = False Then
defaultValue = 0
Else
defaultValue = 1
End If
ActiveSheet.CheckBoxes.Add(12, c.Top + c.Top / c.Height * 0.02, c.Width, c.Height).Select
With Selection
.LinkedCell = c.Address
.Characters.Text = ""
.Name = "CheckBox" & c.Column & c.Row
.Display3DShading = True
.PrintObject = False
.Value = defaultValue
End With
c.Select
With Selection
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=" & c.Address & "=TRUE"
.Font.ColorIndex = 2 'cell background color = White
End With
Next
myRange.Select
'ActiveWindow.Zoom = zoomLevel
End Sub
'*** Must Use at 100% zoom for good alignment***
Sub AddCheckBoxesEquipmentList()
'On Error Resume Next
Dim c As Range, myRange As Range, t As Double, defaultValue, wkshtName As String
wkshtName = "Equipment List"
Worksheets(wkshtName).Activate
Set myRange = Selection
For Each c In myRange.Cells
If c.Height = 12.75 Then
t = 5.5
Else
t = 0
End If
If myRange.Value = False Then
defaultValue = 0
Else
defaultValue = 1
End If
ActiveSheet.CheckBoxes.Add(6, c.Top + t, c.Width, c.Height).Select
With Selection
.LinkedCell = c.Address
.Characters.Text = ""
.Name = "CheckBox" & c.Column & c.Row
.Display3DShading = True
.PrintObject = False
.Value = defaultValue
End With
c.Select
With Selection
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=" & c.Address & "=TRUE"
.Font.ColorIndex = 2 'cell background color = White
End With
Next
myRange.Select
End Sub
Sub deleteAllBoxes()
Dim lastRow As Integer, r As Integer, numBoxes
Application.ScreenUpdating = False
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
numBoxes = ActiveSheet.CheckBoxes.Count
On Error Resume Next
Do While numBoxes > 0
For r = lastRow To 1 Step -1
ActiveSheet.CheckBoxes("CheckBox" & 1 & r).Delete
Next r
numBoxes = ActiveSheet.CheckBoxes.Count
Loop
End Sub
Sub dynamicAddCheckBoxesPerfSummary()
Dim r As Integer, lastRow As Integer, myRange As Range, zoomLevel As Double, i As Integer, wkshtName As String
Dim wasHidden As Boolean
wkshtName = "Perf. Summary"
Worksheets(wkshtName).Activate
ActiveSheet.Unprotect
Application.ScreenUpdating = False
zoomLevel = ActiveWindow.Zoom
ActiveWindow.Zoom = 100
Call deleteAllBoxes
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
For r = lastRow To 1 Step -1
If Cells(r, 2).Value = "CASE NAME" Then
Exit For
End If
If Rows(r).EntireRow.Hidden = True Then
Rows(r).EntireRow.Hidden = False
wasHidden = True
Else
wasHidden = False
End If
Rows(r).RowHeight = 16.5
If Cells(r, 2).Value <> "" And Cells(r, 3).Value <> "" Then
Set myRange = Range(Cells(r, 1), Cells(r, 1))
myRange.Select
Call AddCheckBoxesPerfSummary
If wasHidden = True Then
Rows(r).EntireRow.Hidden = True
ActiveSheet.CheckBoxes("CheckBox" & 1 & r).Visible = False
End If
End If
Next r
ActiveWindow.Zoom = zoomLevel
End Sub
Sub dynamicAddCheckBoxesEquipmentList()
Dim r As Integer, lastRow As Integer, myRange As Range, zoomLevel As Double, i As Integer, wkshtName As String
Dim wasHidden As Boolean
wkshtName = "Equipment List"
Worksheets(wkshtName).Activate
Application.ScreenUpdating = False
zoomLevel = ActiveWindow.Zoom
ActiveWindow.Zoom = 100
Call deleteAllBoxes
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
Call unhideRowsOnEQList
For r = lastRow To 1 Step -1
If Cells(r, 1).Interior.ColorIndex = 15 Then
Exit For
End If
i = 1
If Rows(r).RowHeight > 18 Or Cells(r, 1).Font.Size = 10 Then
Rows(r).RowHeight = 25.5
Else
Rows(r).RowHeight = 12.75
End If
If Cells(r, 2).Value <> "" And Cells(r, 3).Value <> "" Then
Set myRange = Range(Cells(r, 1), Cells(r, 1))
myRange.Select
Call AddCheckBoxesEquipmentList
End If
Next r
Call HideRowsOnEqList
ActiveWindow.Zoom = zoomLevel
'Turn off screen updating
Application.ScreenUpdating = True
End Sub
Sub HideRowsOnEqList()
Dim r As Long, lastRow As Long, i As Long, blankRow As Long, firstRow, wkshtName As String, n As Integer
wkshtName = "Equipment List"
Worksheets(wkshtName).Activate
On Error Resume Next
Application.ScreenUpdating = False
ActiveSheet.Unprotect
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
For r = lastRow To 1 Step -1
If Cells(r, 1).Interior.ColorIndex = 15 Then
Exit For
End If
i = 1
If Cells(r, 1).Value <> True And Cells(r, 2).Value <> "" Then
Rows(r).EntireRow.Hidden = True
ActiveSheet.CheckBoxes("CheckBox" & 1 & r).Visible = False
Do While Cells(r + i, 1).Value = "" And Cells(r + i, 2).Value = "" And Cells(r + i, 3).Value = "" And r + i <= lastRow
If Cells(r + i + 1, 1).Font.Size <> 10 Then
Rows(r + i).EntireRow.Hidden = True
End If
i = i + 1
Loop
End If
If Cells(r, 2).Value = "HEAT RECOVERY STEAM GENERATOR" Then
If Cells(r, 5).Value = 2 Then
Rows(r + 4).EntireRow.Hidden = True
Rows(r + 5).EntireRow.Hidden = True
Rows(r + 6).EntireRow.Hidden = True
ElseIf Cells(r, 5).Value = 1 Then
Rows(r + 4).EntireRow.Hidden = True
Rows(r + 5).EntireRow.Hidden = True
Rows(r + 6).EntireRow.Hidden = True
Rows(r + 7).EntireRow.Hidden = True
Rows(r + 8).EntireRow.Hidden = True
Rows(r + 9).EntireRow.Hidden = True
End If
End If
If Cells(r, 2).Value = "BOILER FEEDWATER PUMPS" And Cells(r + 4, 5).Value = 0 And Cells(r + 5, 5).Value = 0 Then
Rows(r + 4).EntireRow.Hidden = True
Rows(r + 5).EntireRow.Hidden = True
End If
If Cells(r, 1).Font.Size = 10 Then
n = 1
Do While Rows(r + n).EntireRow.Hidden
n = n + 1
Loop
If Cells(r + n, 1).Value = "" And Cells(r + n, 2).Value = "" And Cells(r + n, 3).Value = "" And r + n + 1 <= lastRow Then
Rows(r).EntireRow.Hidden = True
Rows(r + n).EntireRow.Hidden = True
End If
End If
Next r
'ActiveSheet.Protect
End Sub
Sub unhideRowsOnEQList()
Dim r As Long, lastRow As Long, c As Long, blankRow As Long, firstRow, i, j, wkshtName As String
wkshtName = "Equipment List"
Worksheets(wkshtName).Activate
Dim nextUnhiddenRow
On Error Resume Next
Application.ScreenUpdating = False
ActiveSheet.Unprotect
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
For r = lastRow To 1 Step -1
If Rows(r).EntireRow.Hidden = True Then
Rows(r).EntireRow.Hidden = False
ActiveSheet.CheckBoxes("CheckBox" & 1 & r).Visible = True
End If
Next r
'ActiveSheet.Protect
End Sub
Function OperQuan(operation, sysNum, quan, pumpRedun)
Dim a
If operation = "Not Operating" Or sysNum = "Not Used" Or sysNum = 0 Or quan = "Not Used" Then
a = 0
ElseIf pumpRedun = 0 Or pumpRedun = "-" Or pumpRedun = "" Then
a = quan * sysNum
Else
a = sysNum / pumpRedun
End If
a = Application.WorksheetFunction.Ceiling(a, 1)
OperQuan = a
End Function
Function pumpRating(flow As Double, Optional head As Double, Optional specificVolume As Double, Optional flow2 As Double, Optional head2 As Double, Optional roundUp As Boolean, Optional pumpEff As Double)
Dim Ratings
Ratings = Array(0, 0.5, 0.75, 1, 1.5, 2, 3, 5, 7.5, 10, 15, 20, 25, 30, 40, 50, 60, 75, 100, 125, 150, 200, 250, 300, 350, 400, 450, 500, 600, 700, 800, 900, 1000, 1250, 1500, 1750, 2000, 2250, 2500, 3000, 3500, 4000, 4500, 5000, 5500, 6000, 7000, 8000, 9000, 10000, 11000, 12000, 13000, 14000, 15000, 16000, 17000, 18000, 19000, 20000, 22500, 25000, 27500, 30000, 35000, 40000, 45000, 50000)
Dim mechEff(4) As Double
mechEff(0) = 0.5
mechEff(1) = 0.7
mechEff(2) = 0.75
mechEff(3) = 0.8
mechEff(4) = 0.85
Dim MechEffFlows(4) As Double
MechEffFlows(0) = 0
MechEffFlows(1) = 100
MechEffFlows(2) = 200
MechEffFlows(3) = 500
MechEffFlows(4) = 1000
Dim eff
Dim rating
Dim i As Integer, j As Integer, k As Integer
Dim ratingFound
Dim SVOfWater As Double
Dim SV As Double
SVOfWater = 1 / 62.43
If specificVolume <> 0 Then
SV = specificVolume
Else
SV = 1 / 62.43
End If
If flow = 0 Or head = 0 Then
rating = 0
Else
ratingFound = False
If pumpEff > 0 Then
eff = pumpEff
Else
For i = 0 To UBound(MechEffFlows) Step 1
If flow > MechEffFlows(i) Then
eff = mechEff(i)
End If
Next i
End If
rating = (flow * head + flow2 * head2) * SVOfWater / (3960 * eff * SV)
If roundUp = True Then
For j = 0 To UBound(Ratings) - 1 Step 1
If rating >= Ratings(j) And rating < Ratings(j + 1) Then
rating = Ratings(j + 1)
ratingFound = True
Exit For
End If
Next j
If ratingFound = False Then
rating = Application.WorksheetFunction.Ceiling(rating, 5000)
End If
End If
End If
pumpRating = rating
End Function
Function MotorEff(m As String, P, u As String)
Dim e, j, n, rating, ratingFound
Dim Ratings
Ratings = Array(0, 1, 1.5, 2, 3, 5, 7.5, 10, 15, 20, 25, 30, 40, 50, 60, 75, 100, 125, 150, 200, 250, 300, 350, 400, 450, 500, 750, 100, 1250, 1500, 1750, 2000, 2250, 2500, 3000, 3500, 4000, 4500, 5000, 5500, 6000, 7000, 8000, 9000, 10000, 11000, 12000, 13000, 14000, 15000, 16000, 17000, 18000, 19000, 20000, 22500, 27500, 30000, 35000, 40000, 45000, 50000)
Dim eff
eff = Array(83, 83, 84, 85, 87, 88, 89, 90, 91, 91, 92, 92, 93, 93, 94, 94, 94, 95, 95, 95, 95, 95, 95, 95, 95, 95, 96, 96, 96, 96, 96, 96, 97, 97, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98)
If m = "Motor" Then
If u = "kW" Then
rating = P / 0.746
Else
rating = P
End If
For j = 0 To UBound(Ratings) - 1 Step 1
If rating > Ratings(j) And rating <= Ratings(j + 1) Then
e = eff(j + 1) / 100
ratingFound = True
Exit For
End If
Next j
If ratingFound = False Then
e = 98 / 100
End If
Else
e = ""
End If
MotorEff = e
End Function
Function CalcLoad(m As String, P, u As String, Q As Double, eff)
Dim l, f
f = 0.746
If m = "Load" Then
If u = "HP" Then
l = P * Q * f
Else
l = P * Q
End If
ElseIf m = "Motor" Then
If u = "HP" Then
l = P * Q * f / eff
Else
l = P * Q / eff
End If
Else
l = ""
End If
CalcLoad = l
End Function
Function margin(g As String, l)
Dim m, load
If l = 0 Or l = "" Then
m = 0
Else
If g = "Estimate" Then
m = l * 0.1
ElseIf g = "Vendor Quote" Then
m = l * 0.05
Else
m = ""
End If
End If
If m = 0 Then
m = ""
End If
margin = m
End Function
Function checkedRangeToString(valueRange)
Dim r As Integer
Dim numRow As Integer
Dim i As Integer
Dim c As Integer
Dim checkedBoxRange As Range
Dim options As String
Dim TrueCount As Integer
TrueCount = 0
Set checkedBoxRange = valueRange
r = checkedBoxRange.Row
numRow = checkedBoxRange.Rows.Count
c = checkedBoxRange.Column
options = ""
For i = r To r + numRow Step 1
If Cells(i, c) = True Then
TrueCount = TrueCount + 1
If TrueCount > 1 Then
options = options & ", "
End If
options = options & Cells(i, c - 2).Value
End If
Next i
checkedRangeToString = options
End Function
Function pipeStress(material As String, temp As Double)
Dim P91stress, P22stress, A106Bstress, PCCPstress, P91temp, P22temp, A106Btemp, PCCPtemp, i, j, k, s
Dim A106Cstress, A106Ctemp, SS316stress, SS316temp, SS304stress, SS304temp
P91stress = Array(24.3, 24.3, 24.3, 24.3, 24.2, 24.1, 23.7, 23.4, 22.9, 22.2, 21.3, 20.3, 19.1, 17.8, 16.3, 14#, 10.3, 7#, 4.3)
P91temp = Array(0, 100, 200, 300, 400, 500, 600, 650, 700, 750, 800, 850, 900, 950, 1000, 1050, 1100, 1150, 1200)
P22stress = Array(17.1, 17.1, 17.1, 16.6, 16.6, 16.6, 16.6, 16.6, 16.6, 16.6, 16.6, 16.6, 13.6, 10.8, 8#, 5.7, 3.8)
P22temp = Array(0, 100, 200, 300, 400, 500, 600, 650, 700, 750, 800, 850, 900, 950, 1000, 1050, 1100)
A106Bstress = Array(15, 15#, 14.4, 13#, 10.8)
A106Btemp = Array(0, 650, 700, 750, 800)
A106Cstress = Array(17.5, 17.5, 16.6, 14.8, 12#)
A106Ctemp = Array(0, 650, 700, 750, 800)
SS316stress = Array(18.8, 18.8, 16.2, 14.6, 13.4, 12.5, 11.8, 11.6, 11.3, 11.2, 11#, 10.9, 10.8, 10.7, 10.6, 10.5, 10.3, 9.3, 7.4)
SS316temp = Array(0, 100, 200, 300, 400, 500, 600, 650, 700, 750, 800, 850, 900, 950, 1000, 1050, 1100, 1150, 1200)
SS304stress = Array(18.8, 18.8, 15.7, 14.1, 13#, 12.2, 11.4, 11.3, 11.1, 10.8, 10.6, 10.4, 10.2, 10#, 9.8, 9.5, 8.9, 7.7, 6.1)
SS304temp = Array(0, 100, 200, 300, 400, 500, 600, 650, 700, 750, 800, 850, 900, 950, 1000, 1050, 1100, 1150, 1200)
'PCCPstress = Array()
If material = "P91" Then
For i = 0 To UBound(P91stress) - 1 Step 1
If temp > P91temp(i) And temp <= P91temp(i + 1) Then
s = P91stress(i) * 1000 + (temp - P91temp(i)) * (P91stress(i + 1) * 1000 - P91stress(i) * 1000) / (P91temp(i + 1) - P91temp(i))
Exit For
End If
Next i
ElseIf material = "P22" Then
For i = 0 To UBound(P22stress) - 1 Step 1
If temp > P22temp(i) And temp <= P22temp(i + 1) Then
s = P22stress(i) * 1000 + (temp - P22temp(i)) * (P22stress(i + 1) * 1000 - P22stress(i) * 1000) / (P22temp(i + 1) - P22temp(i))
End If
Next i
ElseIf material = "A 106 B" Then
For i = 0 To UBound(A106Bstress) - 1 Step 1
If temp > A106Btemp(i) And temp <= A106Btemp(i + 1) Then
s = A106Bstress(i) * 1000 + (temp - A106Btemp(i)) * (A106Bstress(i + 1) * 1000 - A106Bstress(i) * 1000) / (A106Btemp(i + 1) - A106Btemp(i))
End If
Next i
ElseIf material = "A 106 C" Then
For i = 0 To UBound(A106Cstress) - 1 Step 1
If temp > A106Ctemp(i) And temp <= A106Ctemp(i + 1) Then
s = A106Cstress(i) * 1000 + (temp - A106Ctemp(i)) * (A106Cstress(i + 1) * 1000 - A106Cstress(i) * 1000) / (A106Ctemp(i + 1) - A106Ctemp(i))
End If
Next i
ElseIf material = "316 SS" Then
For i = 0 To UBound(SS316stress) - 1 Step 1
If temp > SS316temp(i) And temp <= SS316temp(i + 1) Then
s = SS316stress(i) * 1000 + (temp - SS316temp(i)) * (SS316stress(i + 1) * 1000 - SS316stress(i) * 1000) / (SS316temp(i + 1) - SS316temp(i))
End If
Next i
ElseIf material = "304 SS" Then
For i = 0 To UBound(SS304stress) - 1 Step 1
If temp > SS304temp(i) And temp <= SS304temp(i + 1) Then
s = SS304stress(i) * 1000 + (temp - SS304temp(i)) * (SS304stress(i + 1) * 1000 - SS304stress(i) * 1000) / (SS304temp(i + 1) - SS304temp(i))
End If
Next i
ElseIf material = "PCCP" Then
s = 0
End If
pipeStress = Application.WorksheetFunction.Floor(s, 100)
End Function
Function yValue(desTemp As Double, matType As String)
Dim y As Double
If matType = "316 SS" Or matType = "304 SS" Then
If desTemp <= 1050 Then
y = 0.4
ElseIf desTemp <= 1100 Then
y = -(1100 - desTemp) / (1100 - 1050) * (0.5 - 0.4) + 0.5
ElseIf desTemp <= 1150 Then
y = -(1150 - desTemp) / (1150 - 1100) * (0.7 - 0.5) + 0.7
Else
y = 0.7
End If
Else
If desTemp <= 900 Then
y = 0.4
ElseIf desTemp <= 950 Then
y = -(950 - desTemp) / (950 - 900) * (0.5 - 0.4) + 0.5
ElseIf desTemp <= 1000 Then
y = -(1000 - desTemp) / (1000 - 950) * (0.7 - 0.5) + 0.7
Else
y = 0.7
End If
End If
yValue = y
End Function
Function weldRedFactor(desTemp As Double, matType As String)
Dim w
If matType = "P91" Or matType = "P22" Then
If desTemp <= 800 Then
w = 1
ElseIf desTemp <= 850 Then
w = 0.95
ElseIf desTemp <= 900 Then
w = 0.91
ElseIf desTemp <= 950 Then
w = 0.86
ElseIf desTemp <= 1000 Then
w = 0.82
ElseIf desTemp <= 1050 Then
w = 0.77
ElseIf desTemp <= 1100 Then
w = 0.73
ElseIf desTemp <= 1150 Then
w = 0.68
ElseIf desTemp <= 1200 Then
w = 0.64
Else
w = 0
End If
ElseIf matType = "A 106 B" Or matType = "A 106 C" Then
If desTemp <= 700 Then
w = 1
ElseIf desTemp <= 750 Then
w = 0.95
ElseIf desTemp <= 800 Then
w = 0.91
Else
w = 0
End If
ElseIf matType = "316 SS" Or matType = "304 SS" Then
If desTemp <= 950 Then
w = 1
ElseIf desTemp <= 1000 Then
w = 0.95
ElseIf desTemp <= 1050 Then
w = 0.91
ElseIf desTemp <= 1100 Then
w = 0.86
ElseIf desTemp <= 1150 Then
w = 0.82
ElseIf desTemp <= 1200 Then
w = 0.77
Else
w = 0
End If
Else
w = 1
End If
weldRedFactor = w
End Function
Function corrAll(matType As String)
Dim c As Double
If matType = "P91" Or matType = "P22" Then
c = 0.01
ElseIf matType = "A 106 B" Or matType = "A 106 C" Then
c = 0.0625
Else
c = 0
End If
corrAll = c
End Function
Function pumpRound(power As Double)
Dim Ratings
Ratings = Array(0, 1, 1.5, 2, 3, 5, 7.5, 10, 15, 20, 25, 30, 40, 50, 60, 75, 100, 125, 150, 200, 250, 300, 350, 400, 450, 500, 750, 100, 1250, 1500, 1750, 2000, 2250, 2500, 3000, 3500, 4000, 4500, 5000, 5500, 6000, 7000, 8000, 9000, 10000, 11000, 12000, 13000, 14000, 15000, 16000, 17000, 18000, 19000, 20000, 22500, 27500, 30000, 35000, 40000, 45000, 50000)
Dim rating
Dim i As Integer, j As Integer, k As Integer
Dim ratingFound
If power = 0 Then
rating = 0
Else
ratingFound = False
rating = power
For j = 0 To UBound(Ratings) - 1 Step 1
If rating > Ratings(j) And rating < Ratings(j + 1) Then
rating = Ratings(j + 1)
ratingFound = True
Exit For
End If
Next j
If ratingFound = False Then
rating = Application.WorksheetFunction.Ceiling(rating, 5000)
End If
End If
pumpRound = rating
End Function
