Excel, Compare cells in a range and change colour accordingly-CodePudding

Been trying to tackle this problem for a quite a while now, but I keep coming up short!

Essentially I have a named range of cells, and i wish to check if each cell in the range is larger than the one above, and change its interior colour when this happens, or if the cell is the same value, set the colour accordingly. To achieve the outcome as seen below (ignore the grey lines)

The problem i'm having is getting this to work, because the named range changes on each refresh! So i can't code static cells in, they have to be different everytime!

Any thoughts?

What haven't I tried...? haha

if functions, cell offsets, you name it! Maybe i just need to up my coding game :D

Dim Col0 As Long
Dim Col1 As Long
Dim Col2 As Long
Dim Col3 As Long
Dim Col4 As Long
Dim Col5 As Long
Dim Col6 As Long
Dim Col7 As Long

c = 0

Col0 = RGB(142, 169, 219)
Col1 = RGB(213, 184, 234)
Col2 = RGB(255, 217, 102)
Col3 = RGB(169, 208, 142)
Col4 = RGB(244, 176, 132)
Col5 = RGB(180, 238, 210)
Col6 = RGB(208, 215, 145)
Col7 = RGB(167, 127, 225)

WS.Range("C9").Interior.Color = Col1

Dim tms As Range
pr = 0
pr = ActiveSheet.Range("B15", ActiveSheet.Cells(Rows.Count, "B").End(xlUp)).Count
Set tms = Application.Range("B15:B" & 14   pr)

Dim First As Integer
Dim Last As Integer

First = 15
Last = 15   pr - 1

Debug.Print First
Debug.Print Last

If First <> Last Then
    WS.Range("B"   First).Interior.Color = Col1
Else
    Cells(k, 3).Value = "Same"
End If

Set Cel1 = WS.Range("B15")

'Col0 = "14395790"
'Col1 = "15382741"
'Col2 = "6740479"
'Col3 = "9359529"
'Col4 = "8696052"
'Col5 = "13823668"
'Col6 = "9557968"
'Col7 = "14778279"

t = 0

'MsgBox pr






'tms.Interior.Color = Col1

'For Each cel In tms.Cells

'If Cel1.Value < Cel2.Value

'    Cel1.Interior.Color = "Col" & c
'    c = c   1
'    End If

't = t   1

'Next cel
'On Error Resume Next

CodePudding user response：

Here Mike. You were on the right track, but you lacked to keep the current color available for follwing rows in case the time didn't change. Please pay attention to the usage of an array of colors. With an array you get easy access to the elements via a numerical index ('ColorIndex' in the code).

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Set ws = Worksheets(1)
    
    'Dim c As Long
    Dim CurrRow As Long     'The row we are currently evaluating
    Dim PrevRow As Long     'The previous row (act. first of current time)
    Dim CurrColor As Long   'The color index currently in use
    Dim ColorArr As Variant 'Array of colors
    Dim ColorIndex As Integer
    
    Dim Color0 As Long
    Dim Color1 As Long
    Dim Color2 As Long
    Dim Color3 As Long
    Dim Color4 As Long
    Dim Color5 As Long
    Dim Color6 As Long
    Dim Color7 As Long
    
    'Define the colors
    Color0 = RGB(142, 169, 219)
    Color1 = RGB(213, 184, 234)
    Color2 = RGB(255, 217, 102)
    Color3 = RGB(169, 208, 142)
    Color4 = RGB(244, 176, 132)
    Color5 = RGB(180, 238, 210)
    Color6 = RGB(208, 215, 145)
    Color7 = RGB(167, 127, 225)
    
    'Define an array of those colors
    ColorArr = Array(Color0, Color1, Color2, Color3, Color4, Color5, Color6, Color7)
    
    'Initial index that we will use
    ColorIndex = 0
    
    'Test of the color ?
    ws.Range("C9").Interior.Color = ColorArr(ColorIndex)
    
    Dim pr As Long
    Dim tms As Range
    
    pr = 0
    pr = ActiveSheet.Range("B15", ActiveSheet.Cells(Rows.Count, "B").End(xlUp)).Count
    Set tms = Application.Range("B15:B" & 14   pr)
    
    Dim First As Integer
    Dim Last As Integer
    
    First = 15
    Last = 15   pr - 1
    
    Debug.Print First
    Debug.Print Last
    
    
    'Traverse the cells with the time stamps
    'Color the first cell with the initial fill color
    'Following cells are colored with the same color ...
    '... if the time in cell is the same as previous
    'If the time in the cell is different ...
    '  - update PrewRow to the current
    '  - update ColorIndex
    'Finally, fill cell
    '
    PrevRow = First
    For CurrRow = First To Last
        If CurrRow = First Then
            Cells(CurrRow, 2).Interior.Color = ColorArr(ColorIndex)
        Else

            'Check if time is different from previous
            If Cells(CurrRow, 2).Value <> Cells(PrevRow, 2).Value Then
                PrevRow = CurrRow
                ColorIndex = ColorIndex   1
            End If

            'Fill cell
            Cells(CurrRow, 2).Interior.Color = ColorArr(ColorIndex)
        End If
    Next
    
End Sub