Option Explicit
'Traffic Light Colours
'Const NoDataColour As Long = &HCCCCCC
Const ZeroValueColour As Long = &HFFFFFF
Const Band01Colour As Long = &HD2FFCD
Const Band02Colour As Long = &HAAFFA0
Const Band03Colour As Long = &H6EFF64
Const Band04Colour As Long = &H3CFFA0
Const Band05Colour As Long = &H2DFFC8
Const Band06Colour As Long = &H1EFFFF
Const Band07Colour As Long = &HFDCFF
Const Band08Colour As Long = &H1AAFF
Const Band09Colour As Long = &H78FF
Const Band10Colour As Long = &HFF
'Alternative Colours
'Const NoDataColour As Long = &HCCCCCC
Const AltZeroColour As Long = &HFFFFFF
Const Alt01Colour As Long = &HF2F2F2
Const Alt02Colour As Long = &HD9D9D9
Const Alt03Colour As Long = &HCCCCCC
Const Alt04Colour As Long = &HBFBFBF
Const Alt05Colour As Long = &HB3B3B3
Const Alt06Colour As Long = &H999999
Const Alt07Colour As Long = &H737373
Const Alt08Colour As Long = &H4F4F4F
Const Alt09Colour As Long = &H262626
Const Alt10Colour As Long = &H0
Sub Recalculate()
Dim iRow, iCol As Long
Dim iCustomRow, iCustomCol As Long
Dim iR, iC As Long
Dim OpenCol, CloseCol As Long
Dim sglMin, sglMax, sglAlarm As Single
Dim TimeOpen, TimeClose As String
Dim colour As Long
Dim tRange As String
Dim numberFormat As String
Set xCustom = Sheets("Custom")
Set xData = Sheets("Calcs_E")
xFlag = Range("BE25")
SetLegendColours
'establish max, min & alarm points
sglMax = xCustom.Cells(21, 57)
sglMin = xCustom.Cells(22, 57)
sglAlarm = xCustom.Cells(24, 57)
'Set Start and Close time for off peak calc
TimeOpen = CStr(Range("BE3"))
TimeClose = CStr(Range("BF3"))
'Clear and redraw borders for Opening/Closing time
Application.ScreenUpdating = False
Range("C7:AX41").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Range("BJ9:BJ56").Select
Selection.Find(What:=TimeOpen, After:=ActiveCell, SearchOrder:=xlByRows, SearchDirection:=xlNext).Select
OpenCol = ActiveCell.Offset(0, 1).Value
Range("BJ9:BJ56").Select
Selection.Find(What:=TimeClose, After:=ActiveCell, SearchOrder:=xlByRows, SearchDirection:=xlNext).Select
CloseCol = ActiveCell.Offset(0, 1).Value
Range(Cells(7, OpenCol), Cells(41, CloseCol)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
Application.ScreenUpdating = True
' determine the number of decimal places to show for the bands
Select Case True
Case (sglMax < 1)
numberFormat = "########0.00"
Case (sglMax < 10)
numberFormat = "########0.0"
Case Else
numberFormat = "########0"
End Select
' format values in the Legend
Application.Goto Reference:="LegendValuesE"
Selection.numberFormat = numberFormat
'Clear previous colours and any values
Range("C9:AX39").Select
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
Selection.ClearContents
Range("C56:AX86").Select
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
Selection.ClearContents
Application.Goto Reference:="R2C2"
'start row on data (Calcs_E) sheet
iRow = 12: iCol = 5
Dim Peak As String
Dim PeakFlag As Boolean
For iCustomRow = 9 To 39
iCustomCol = 3 'Start column for colour map
For iC = 1 To 48 'total rows for colour map
If xCustom.Cells(6, iCustomCol) = "T" Then
PeakFlag = True
Else
PeakFlag = False
End If
Select Case xData.Cells(iRow, iCol)
Case Is <= 0
If xFlag <> True Then colour = ZeroValueColour Else colour = AltZeroColour
Case Is < xCustom.Cells(9, 57)
If xFlag <> True Then colour = Band01Colour Else colour = Alt01Colour
Case Is < xCustom.Cells(10, 57)
If xFlag <> True Then colour = Band02Colour Else colour = Alt02Colour
Case Is < xCustom.Cells(11, 57)
If xFlag <> True Then colour = Band03Colour Else colour = Alt03Colour
Case Is < xCustom.Cells(12, 57)
If xFlag <> True Then colour = Band04Colour Else colour = Alt04Colour
Case Is < xCustom.Cells(13, 57)
If xFlag <> True Then colour = Band05Colour Else colour = Alt05Colour
Case Is < xCustom.Cells(14, 57)
If xFlag <> True Then colour = Band06Colour Else colour = Alt06Colour
Case Is < xCustom.Cells(15, 57)
If xFlag <> True Then colour = Band07Colour Else colour = Alt07Colour
Case Is < xCustom.Cells(16, 57)
If xFlag <> True Then colour = Band08Colour Else colour = Alt08Colour
Case Is < xCustom.Cells(17, 57)
If xFlag <> True Then colour = Band09Colour Else colour = Alt09Colour
Case Else
If xFlag <> True Then colour = Band10Colour Else colour = Alt10Colour
End Select
'Apply colour to cell
xCustom.Cells(iCustomRow, iCustomCol).Interior.Color = colour
'if the value is greater that the alarm AND the Peak flag is true then shade to denote exessive use
If xData.Cells(iRow, iCol) > sglAlarm And PeakFlag = True Then xCustom.Cells(iCustomRow, iCustomCol).Interior.Pattern = xlLightUp
'If xData.Cells(iRow, iCol) = sglMin Then xCustom.Cells(iCustomRow, iCustomCol) = "m" 'Minimum
If xData.Cells(iRow, iCol) = sglMax Then xCustom.Cells(iCustomRow, iCustomCol) = "M" 'Maximum
iRow = iRow + 1
iCustomCol = iCustomCol + 1
Next iC
'Determines if this is the end of a row
If iCustomRow > 11 And Day(xCustom.Cells(iCustomRow, 2) + 1) = 1 Then Exit For
Next iCustomRow
'----------------------------------------
'Working on Gas calculations
'----------------------------------------
Set xData = Sheets("Calcs_GO")
Set xCustom = Sheets("Custom")
SetLegendColours
'establish max and min points
sglMax = xCustom.Cells(68, 57)
sglMin = xCustom.Cells(69, 57)
sglAlarm = xCustom.Cells(69, 71)
'Clear and redraw borders for Opening/Closing time
Application.ScreenUpdating = False
Range("C54:AX88").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
'As we have already esatblished the Opening & Coloing columns, just update
Range(Cells(54, OpenCol), Cells(88, CloseCol)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
Application.ScreenUpdating = True
' determine the number of decimal places to show for the bands
Select Case True
Case (sglMax < 1)
numberFormat = "########0.00"
Case (sglMax < 10)
numberFormat = "########0.0"
Case Else
numberFormat = "########0"
End Select
' format values in the Legend
Application.Goto Reference:="LegendValuesG"
Selection.numberFormat = numberFormat
Application.Goto Reference:="R2C2"
'start row on data sheet
iRow = 12: iCol = 5
ActiveWindow.ScrollRow = 47
Range("B47:BF47").Select
For iCustomRow = 56 To 86
iCustomCol = 3
For iC = 1 To 48
If xCustom.Cells(6, iCustomCol) = "T" Then
PeakFlag = True
Else
PeakFlag = False
End If
Select Case xData.Cells(iRow, iCol)
Case Is <= 0
If xFlag <> True Then colour = ZeroValueColour Else colour = AltZeroColour
Case Is < xCustom.Cells(56, 57)
If xFlag <> True Then colour = Band01Colour Else colour = Alt01Colour
Case Is < xCustom.Cells(57, 57)
If xFlag <> True Then colour = Band02Colour Else colour = Alt02Colour
Case Is < xCustom.Cells(58, 57)
If xFlag <> True Then colour = Band03Colour Else colour = Alt03Colour
Case Is < xCustom.Cells(59, 57)
If xFlag <> True Then colour = Band04Colour Else colour = Alt04Colour
Case Is < xCustom.Cells(60, 57)
If xFlag <> True Then colour = Band05Colour Else colour = Alt05Colour
Case Is < xCustom.Cells(61, 57)
If xFlag <> True Then colour = Band06Colour Else colour = Alt06Colour
Case Is < xCustom.Cells(62, 57)
If xFlag <> True Then colour = Band07Colour Else colour = Alt07Colour
Case Is < xCustom.Cells(63, 57)
If xFlag <> True Then colour = Band08Colour Else colour = Alt08Colour
Case Is < xCustom.Cells(64, 57)
If xFlag <> True Then colour = Band09Colour Else colour = Alt09Colour
Case Else
If xFlag <> True Then colour = Band10Colour Else colour = Alt10Colour
End Select
'Apply colour to cell
xCustom.Cells(iCustomRow, iCustomCol).Interior.Color = colour
'if the value is greater that the alarm AND the Peak flag is true then shade to denote exessive use
If xData.Cells(iRow, iCol) > sglAlarm And PeakFlag = True Then xCustom.Cells(iCustomRow, iCustomCol).Interior.Pattern = xlLightUp
'If xData.Cells(iRow, iCol) = sglMin Then xCustom.Cells(iCustomRow, iCustomCol) = "m" 'Minimum
If xData.Cells(iRow, iCol) = sglMax Then xCustom.Cells(iCustomRow, iCustomCol) = "M" 'Maximum
iRow = iRow + 1
iCustomCol = iCustomCol + 1
Next iC
If iCustomRow > 11 And Day(xCustom.Cells(iCustomRow, 2) + 1) = 1 Then Exit For
Next iCustomRow
Application.Goto Reference:="R2C2"
Application.ScreenUpdating = True
End Sub
Private Sub SetLegendColours()
Select Case xFlag
Case False
xCustom.Cells(9, 56).Interior.Color = ZeroValueColour
xCustom.Cells(10, 56).Interior.Color = Band01Colour
xCustom.Cells(11, 56).Interior.Color = Band02Colour
xCustom.Cells(12, 56).Interior.Color = Band03Colour
xCustom.Cells(13, 56).Interior.Color = Band04Colour
xCustom.Cells(14, 56).Interior.Color = Band05Colour
xCustom.Cells(15, 56).Interior.Color = Band06Colour
xCustom.Cells(16, 56).Interior.Color = Band07Colour
xCustom.Cells(17, 56).Interior.Color = Band08Colour
xCustom.Cells(18, 56).Interior.Color = Band09Colour
xCustom.Cells(19, 56).Interior.Color = Band10Colour
xCustom.Cells(56, 56).Interior.Color = ZeroValueColour
xCustom.Cells(57, 56).Interior.Color = Band01Colour
xCustom.Cells(58, 56).Interior.Color = Band02Colour
xCustom.Cells(59, 56).Interior.Color = Band03Colour
xCustom.Cells(60, 56).Interior.Color = Band04Colour
xCustom.Cells(61, 56).Interior.Color = Band05Colour
xCustom.Cells(62, 56).Interior.Color = Band06Colour
xCustom.Cells(63, 56).Interior.Color = Band07Colour
xCustom.Cells(64, 56).Interior.Color = Band08Colour
xCustom.Cells(65, 56).Interior.Color = Band09Colour
xCustom.Cells(66, 56).Interior.Color = Band10Colour
Case True
xCustom.Cells(9, 56).Interior.Color = AltZeroColour
xCustom.Cells(10, 56).Interior.Color = Alt01Colour
xCustom.Cells(11, 56).Interior.Color = Alt02Colour
xCustom.Cells(12, 56).Interior.Color = Alt03Colour
xCustom.Cells(13, 56).Interior.Color = Alt04Colour
xCustom.Cells(14, 56).Interior.Color = Alt05Colour
xCustom.Cells(15, 56).Interior.Color = Alt06Colour
xCustom.Cells(16, 56).Interior.Color = Alt07Colour
xCustom.Cells(17, 56).Interior.Color = Alt08Colour
xCustom.Cells(18, 56).Interior.Color = Alt09Colour
xCustom.Cells(19, 56).Interior.Color = Alt10Colour
xCustom.Cells(56, 56).Interior.Color = AltZeroColour
xCustom.Cells(57, 56).Interior.Color = Alt01Colour
xCustom.Cells(58, 56).Interior.Color = Alt02Colour
xCustom.Cells(59, 56).Interior.Color = Alt03Colour
xCustom.Cells(60, 56).Interior.Color = Alt04Colour
xCustom.Cells(61, 56).Interior.Color = Alt05Colour
xCustom.Cells(62, 56).Interior.Color = Alt06Colour
xCustom.Cells(63, 56).Interior.Color = Alt07Colour
xCustom.Cells(64, 56).Interior.Color = Alt08Colour
xCustom.Cells(65, 56).Interior.Color = Alt09Colour
xCustom.Cells(66, 56).Interior.Color = Alt10Colour
End Select
End Sub