SHUTDOWN SHEET UPDATE
unknown
plain_text
a year ago
18 kB
6
Indexable
Sub TestMacro()
RunLogicForColumn 3 ' Run the logic for Column C
RunLogicForColumn 5 ' Run the logic for Column E
End Sub
Sub RunLogicForColumn(col As Integer)
Range(Cells(2, col), Cells(507, col)).Interior.ColorIndex = xlNone
Dim last_row As Long
last_row = 507
' First pass without special logic
For i = 2 To last_row
' Check if cells have numeric values, skip if not
If Not IsNumeric(Val(CStr(Cells(i, col).Value))) Or IsError(Cells(i, col).Value) Or Cells(i, col).Value = "Inp OutRange" Or Cells(i, col).Value = "Bad Input" Or Cells(i, col).Value = "No Sample" Or Not IsNumeric(Val(CStr(Cells(i, 7).Value))) Or IsError(Cells(i, 7).Value) Or Cells(i, 7).Value = "Inp OutRange" Or Cells(i, 7).Value = "Bad Input" Or Cells(i, 7).Value = "No Sample" Or Not IsNumeric(Val(CStr(Cells(i, 8).Value))) Or IsError(Cells(i, 8).Value) Or Cells(i, 8).Value = "Inp OutRange" Or Cells(i, 8).Value = "Bad Input" Or Cells(i, 8).Value = "No Sample" Or Not IsNumeric(Val(CStr(Cells(i, 9).Value))) Or IsError(Cells(i, 9).Value) Or Cells(i, 9).Value = "Inp OutRange" Or Cells(i, 9).Value = "Bad Input" Or Cells(i, 9).Value = "No Sample" Or Not IsNumeric(Val(CStr(Cells(i, 10).Value))) Or IsError(Cells(i, 10).Value) Or Cells(i, 10).Value = "Inp OutRange" Or Cells(i, 10).Value = "Bad Input" Or Cells(i, 10).Value = "No Sample" Then
' Skip the row if any of the relevant cells do not have numeric values
GoTo SkipRow
End If
' Identify the type of row and apply formatting accordingly
Select Case True
Case i = 119 Or i = 120 Or i = 151 Or i = 152 Or i = 162 Or i = 163
' Case X: NORMAL/ALARM Checking
If CStr(Cells(i, col).Value) = "ALARM" Then
Cells(i, col).Interior.Color = RGB(255, 0, 0) ' red
ElseIf CStr(Cells(i, col).Value) = "NORMAL" Then
Cells(i, col).Interior.Color = RGB(0, 255, 0) ' green
End If
Case Cells(i, 7).Value = "" And Cells(i, 8).Value <> "" And Cells(i, 9).Value = "" And Cells(i, 10).Value = ""
' Case A: Only low threshold value in column H, no limits in G, I, or J
If Val(CStr(Cells(i, col).Value)) <= Val(CStr(Cells(i, 7).Value)) Then
Cells(i, col).Interior.Color = RGB(255, 0, 0) ' red
ElseIf Val(CStr(Cells(i, col).Value)) > Val(CStr(Cells(i, 7).Value)) Then
Cells(i, col).Interior.Color = RGB(0, 255, 0) ' green
End If
Case Cells(i, 7).Value = "" And Cells(i, 8).Value = "" And Cells(i, 9).Value <> "" And Cells(i, 10).Value = ""
' Case B: Only high threshold value in column I, no limits in G, H, or J
If Val(CStr(Cells(i, col).Value)) < Val(CStr(Cells(i, 8).Value)) Then
Cells(i, col).Interior.Color = RGB(255, 0, 0) ' red
ElseIf Val(CStr(Cells(i, col).Value)) >= Val(CStr(Cells(i, 8).Value)) Then
Cells(i, col).Interior.Color = RGB(0, 255, 0) ' green
End If
Case Cells(i, 7).Value = "" And Cells(i, 8).Value <> "" And Cells(i, 9).Value <> "" And Cells(i, 10).Value = ""
' Case C: Only low and high threshold values in columns H and I, no limits in G or J
If Val(CStr(Cells(i, col).Value)) >= Val(CStr(Cells(i, 8).Value)) And Val(CStr(Cells(i, col).Value)) <= Val(CStr(Cells(i, 9).Value)) Then
Cells(i, col).Interior.Color = RGB(0, 255, 0) ' green
ElseIf Val(CStr(Cells(i, col).Value)) > Val(CStr(Cells(i, 9).Value)) Or Val(CStr(Cells(i, col).Value)) < Val(CStr(Cells(i, 8).Value)) Then
Cells(i, col).Interior.Color = RGB(255, 0, 0) ' red
End If
Case Cells(i, 7).Value <> "" And Cells(i, 8).Value <> "" And Cells(i, 9).Value <> "" And Cells(i, 10).Value <> ""
' Case D: Low and high threshold values in columns H and I, and high threshold value in column J
If Val(CStr(Cells(i, col).Value)) >= Val(CStr(Cells(i, 8).Value)) And Val(CStr(Cells(i, col).Value)) <= Val(CStr(Cells(i, 9).Value)) Then
Cells(i, col).Interior.Color = RGB(0, 255, 0) ' green
ElseIf (Val(CStr(Cells(i, col).Value)) >= Val(CStr(Cells(i, 7).Value)) And Val(CStr(Cells(i, col).Value)) <= Val(CStr(Cells(i, 8).Value))) Or (Val(CStr(Cells(i, col).Value)) >= Val(CStr(Cells(i, 9).Value)) And Val(CStr(Cells(i, col).Value)) <= Val(CStr(Cells(i, 10).Value))) Then
Cells(i, col).Interior.Color = RGB(255, 165, 0) ' orange
ElseIf Val(CStr(Cells(i, col).Value)) > Val(CStr(Cells(i, 10).Value)) Or Val(CStr(Cells(i, col).Value)) < Val(CStr(Cells(i, 7).Value)) Then
Cells(i, col).Interior.Color = RGB(255, 0, 0) ' red
End If
Case Cells(i, 7).Value <> "" And Cells(i, 8).Value <> "" And Cells(i, 9).Value = "" And Cells(i, 10).Value = ""
' Case E: Low threshold and limit values in columns G and H
If Val(CStr(Cells(i, col).Value)) > Val(CStr(Cells(i, 8).Value)) Then
Cells(i, col).Interior.Color = RGB(0, 255, 0) ' green
ElseIf Val(CStr(Cells(i, col).Value)) <= Val(CStr(Cells(i, 8).Value)) And Val(CStr(Cells(i, col).Value)) > Val(CStr(Cells(i, 7).Value)) Then
Cells(i, col).Interior.Color = RGB(255, 165, 0) ' orange
ElseIf Val(CStr(Cells(i, col).Value)) <= Val(CStr(Cells(i, 7).Value)) Then
Cells(i, col).Interior.Color = RGB(255, 0, 0) ' red
End If
Case Cells(i, 7).Value = "" And Cells(i, 8).Value = "" And Cells(i, 9).Value <> "" And Cells(i, 10).Value <> ""
' Case F: High threshold and limit values in columns I and J
If Val(CStr(Cells(i, col).Value)) < Val(CStr(Cells(i, 9).Value)) Then
Cells(i, col).Interior.Color = RGB(0, 255, 0) ' green
ElseIf Val(CStr(Cells(i, col).Value)) >= Val(CStr(Cells(i, 9).Value)) And Val(CStr(Cells(i, col).Value)) < Val(CStr(Cells(i, 10).Value)) Then
Cells(i, col).Interior.Color = RGB(255, 165, 0) ' orange
ElseIf Val(CStr(Cells(i, col).Value)) >= Val(CStr(Cells(i, 10).Value)) Then
Cells(i, col).Interior.Color = RGB(255, 0, 0) ' red
End If
End Select
SkipRow:
Next i
' Second pass for special logic
For i = 264 To 351 Step 2
' Check if both rows have numeric values, skip if not
If Not IsNumeric(Val(CStr(Cells(i, col).Value))) Or IsError(Cells(i, col).Value) Or Cells(i, col).Value = "Inp OutRange" Or Cells(i, col).Value = "Bad Input" Or Cells(i, col).Value = "No Sample" Or Not IsNumeric(Val(CStr(Cells(i + 1, col).Value))) Or IsError(Cells(i + 1, col).Value) Or Cells(i + 1, col).Value = "Inp OutRange" Or Cells(i + 1, col).Value = "Bad Input" Or Cells(i + 1, col).Value = "No Sample" Then
' Skip the rows if any of the relevant cells do not have numeric values
GoTo SkipSpecialRow
End If
' Calculate the difference for the entire group
Dim absDiffGroup1 As Double
absDiffGroup1 = Abs(Val(Cells(i + 1, col).Value) - Val(Cells(i, col).Value))
' Set the color based on the diffGroup value
If absDiffGroup1 < 2 Then
Cells(i, col).Interior.Color = RGB(0, 255, 0) ' green
Cells(i + 1, col).Interior.Color = RGB(0, 255, 0) ' green (apply to both rows in the group)
ElseIf absDiffGroup1 >= 2 And absDiffGroup1 < 3 Then
Cells(i, col).Interior.Color = RGB(255, 165, 0) ' orange
Cells(i + 1, col).Interior.Color = RGB(255, 165, 0) ' orange (apply to both rows in the group)
ElseIf absDiffGroup1 >= 3 Then
Cells(i, col).Interior.Color = RGB(255, 0, 0) ' red
Cells(i + 1, col).Interior.Color = RGB(255, 0, 0) ' red (apply to both rows in the group)
End If
SkipSpecialRow:
Next i
' Third pass for additional special logic (Rows 352 to 439)
For i = 353 To 440 Step 2
' Check if both rows have numeric values, skip if not
If Not IsNumeric(Val(CStr(Cells(i, col).Value))) Or IsError(Cells(i, col).Value) Or Cells(i, col).Value = "Inp OutRange" Or Cells(i, col).Value = "Bad Input" Or Cells(i, col).Value = "No Sample" Or Not IsNumeric(Val(CStr(Cells(i + 1, col).Value))) Or IsError(Cells(i + 1, col).Value) Or Cells(i + 1, col).Value = "Inp OutRange" Or Cells(i + 1, col).Value = "Bad Input" Or Cells(i + 1, col).Value = "No Sample" Then
' Skip the rows if any of the relevant cells do not have numeric values
GoTo SkipAdditionalSpecialRow
End If
' Calculate the absolute difference for the group
Dim absDiffGroup2 As Double
absDiffGroup = Abs(Val(Cells(i + 1, col).Value) - Val(Cells(i, col).Value))
' Set the color based on the absDiffGroup value
If absDiffGroup2 < 4.5 Then
Cells(i, col).Interior.Color = RGB(0, 255, 0) ' green
Cells(i + 1, col).Interior.Color = RGB(0, 255, 0) ' green (apply to both rows in the group)
Else
Cells(i, col).Interior.Color = RGB(255, 0, 0) ' red
Cells(i + 1, col).Interior.Color = RGB(255, 0, 0) ' red (apply to both rows in the group)
End If
SkipAdditionalSpecialRow:
Next i
' Fourth pass for additional special logic (Groups 1 to 5)
Dim groups As Variant
groups = Array(Array(488, 491, 4), Array(493, 495, 3), Array(497, 499, 3), Array(501, 503, 3), Array(505, 507, 3))
For Each Group In groups
Dim startRow As Long
Dim endRow As Long
Dim groupSize As Long
startRow = Group(0)
endRow = Group(1)
groupSize = Group(2)
' Check if all rows in the group have numeric values, skip if not
Dim numericCheckPassed As Boolean
numericCheckPassed = True
For i = startRow To endRow
If Not IsNumeric(Val(CStr(Cells(i, col).Value))) Or IsError(Cells(i, col).Value) Or Cells(i, col).Value = "Inp OutRange" Or Cells(i, col).Value = "Bad Input" Or Cells(i, col).Value = "No Sample" Then
' Skip the group if any of the relevant cells do not have numeric values
numericCheckPassed = False
Exit For
End If
Next i
If numericCheckPassed Then
' Extract values from the group
Dim values() As Double
ReDim values(1 To groupSize)
For i = 1 To groupSize
values(i) = Val(Cells(startRow + i - 1, 3).Value)
Next i
' Find the highest and lowest values in the group
Dim maxVal As Double
Dim minVal As Double
maxVal = WorksheetFunction.Max(values)
minVal = WorksheetFunction.Min(values)
' Calculate the absolute difference
Dim absDiffGroup3 As Double
absDiffGroup3 = Abs(maxVal - minVal)
' Set the color based on the absDiffGroup value
If absDiffGroup3 < 1.5 Then
For i = startRow To endRow
Cells(i, col).Interior.Color = RGB(0, 255, 0) ' green
Next i
ElseIf absDiffGroup3 >= 1.5 And absDiffGroup3 <= 2 Then
For i = startRow To endRow
Cells(i, col).Interior.Color = RGB(255, 165, 0) ' orange
Next i
ElseIf absDiffGroup3 > 2 Then
For i = startRow To endRow
Cells(i, col).Interior.Color = RGB(255, 0, 0) ' red
Next i
End If
End If
Next Group
' Fifth pass for additional special logic (Rows 18 to 20)
If IsNumeric(Val(CStr(Cells(18, 3).Value))) And Not IsError(Cells(18, 3).Value) And Not Cells(18, 3).Value = "Inp OutRange" And Not Cells(18, 3).Value = "Bad Input" And Not Cells(18, 3).Value = "No Sample" And IsNumeric(Val(CStr(Cells(19, 3).Value))) And Not IsError(Cells(19, 3).Value) And Not Cells(19, 3).Value = "Inp OutRange" And Not Cells(19, 3).Value = "Bad Input" And Not Cells(19, 3).Value = "No Sample" And IsNumeric(Val(CStr(Cells(20, 3).Value))) And Not IsError(Cells(20, 3).Value) And Not Cells(20, 3).Value = "Inp OutRange" And Not Cells(20, 3).Value = "Bad Input" And Not Cells(20, 3).Value = "No Sample" Then
Dim diff1 As Double
Dim diff2 As Double
Dim diff3 As Double
diff1 = Abs(Val(Cells(18, 3).Value) - Val(Cells(19, 3).Value))
diff2 = Abs(Val(Cells(19, 3).Value) - Val(Cells(20, 3).Value))
diff3 = Abs(Val(Cells(20, 3).Value) - Val(Cells(18, 3).Value))
If diff1 > 0.004 Or diff2 > 0.004 Or diff3 > 0.004 Then
Cells(18, 3).Interior.Color = RGB(255, 0, 0) ' red
Cells(19, 3).Interior.Color = RGB(255, 0, 0) ' red
Cells(20, 3).Interior.Color = RGB(255, 0, 0) ' red
End If
End If
' Sixth pass for additional special logic (Rows 13 to 15)
For i = 13 To 15
If IsNumeric(Val(CStr(Cells(i, col).Value))) And Not IsError(Cells(i, col).Value) And Not Cells(i, col).Value = "Inp OutRange" And Not Cells(i, col).Value = "Bad Input" And Not Cells(i, col).Value = "No Sample" And IsNumeric(Val(CStr(Cells(12, 3).Value))) And Not IsError(Cells(12, 3).Value) And Not Cells(12, 3).Value = "Inp OutRange" And Not Cells(12, 3).Value = "Bad Input" And Not Cells(12, 3).Value = "No Sample" Then
Dim diff As Double
diff = Abs(Val(Cells(i, col).Value) - Val(Cells(12, 3).Value))
If diff < 0.04 Then
If Val(Cells(i, col).Value) >= -0.06 And Val(Cells(i, col).Value) <= 0.06 Then
Cells(i, col).Interior.Color = RGB(0, 255, 0) ' green
End If
ElseIf diff >= 0.04 And diff < 0.1 Then
Cells(i, col).Interior.Color = RGB(255, 165, 0) ' orange
ElseIf diff >= 0.1 Then
Cells(i, col).Interior.Color = RGB(255, 0, 0) ' red
End If
End If
Next i
' Seventh pass for pump status in rows 83 to 85
pumpRunningCount = 0 ' Reset pumpRunningCount variable
For i = 83 To 85
pumpRunningCount = pumpRunningCount + Val(Cells(i, col).Value)
Next i
' Apply color based on pumpRunningCount
Select Case pumpRunningCount
Case 0, 3
For i = 83 To 85
Cells(i, col).Interior.Color = RGB(255, 0, 0) ' red
Next i
Case 1
For i = 83 To 85
Cells(i, col).Interior.Color = RGB(0, 255, 0) ' green
Next i
Case 2
For i = 83 To 85
Cells(i, col).Interior.Color = RGB(255, 165, 0) ' orange
Next i
End Select
' Eighth pass for groups of 2 rows (Rows 235 to 262)
Dim diffSecondaryA As Double
Dim diffSecondaryB As Double
For groupStartRow = 235 To 262 Step 2
groupEndRow = groupStartRow + 1
' Check if cells have numeric values, skip if not
If IsNumeric(Val(CStr(Cells(groupStartRow, col).Value))) And Not IsError(Cells(groupStartRow, col).Value) And Not Cells(groupStartRow, col).Value = "Inp OutRange" And Not Cells(groupStartRow, col).Value = "Bad Input" And Not Cells(groupStartRow, col).Value = "No Sample" And IsNumeric(Val(CStr(Cells(groupEndRow, col).Value))) And Not IsError(Cells(groupEndRow, col).Value) And Not Cells(groupEndRow, col).Value = "Inp OutRange" And Not Cells(groupEndRow, col).Value = "Bad Input" And Not Cells(groupEndRow, col).Value = "No Sample" Then
' Calculate the absolute difference between rows A and B
Dim diffAB As Double
diffAB = Abs(Val(Cells(groupStartRow, col).Value) - Val(Cells(groupEndRow, col).Value))
' Check if the difference is within the first range
If diffAB < 0.015 Then
Cells(groupStartRow, col).Interior.Color = RGB(0, 255, 0) ' green
Cells(groupEndRow, col).Interior.Color = RGB(0, 255, 0) ' green
ElseIf diffAB >= 0.015 And diffAB < 0.05 Then
Cells(groupStartRow, col).Interior.Color = RGB(255, 165, 0) ' orange
Cells(groupEndRow, col).Interior.Color = RGB(255, 165, 0) ' orange
ElseIf diffAB >= 0.05 Then
Cells(groupStartRow, col).Interior.Color = RGB(255, 0, 0) ' red
Cells(groupEndRow, col).Interior.Color = RGB(255, 0, 0) ' red
End If
' Calculate the second difference values
diffSecondaryA = Abs(Val(Cells(groupStartRow, col).Value * 100) - Val(Cells(37 + ((groupStartRow - 235) \ 2), col).Value))
diffSecondaryB = Abs(Val(Cells(groupEndRow, col).Value * 100) - Val(Cells(37 + ((groupEndRow - 235) \ 2), col).Value))
' Apply color based on the second differences
If diffSecondaryA < 3 And diffSecondaryB < 3 Then
Cells(groupStartRow, col).Interior.Color = RGB(0, 255, 0) ' green
Cells(groupEndRow, col).Interior.Color = RGB(0, 255, 0) ' green
ElseIf diffSecondaryA >= 3 And diffSecondaryB >= 3 And diffSecondaryA < 4 And diffSecondaryB < 4 Then
Cells(groupStartRow, col).Interior.Color = RGB(255, 165, 0) ' orange
Cells(groupEndRow, col).Interior.Color = RGB(255, 165, 0) ' orange
ElseIf diffSecondaryA >= 4 And diffSecondaryB >= 4 Then
Cells(groupStartRow, col).Interior.Color = RGB(255, 0, 0) ' red
Cells(groupEndRow, col).Interior.Color = RGB(255, 0, 0) ' red
End If
End If
Next groupStartRow
End SubEditor is loading...
Leave a Comment