SHUTDOWN SHEET UPDATE

 avatar
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