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 Sub
Editor is loading...
Leave a Comment