Color Rows by Criteria
I have a spreadsheet where the closing value of my portfolio, the NASDAQ, the DJIA, and the S&P close is recorded. See sample below.
Since it is almost 5K rows, I decided I wanted to color the rows with a specific color based on the year. My list is complete from year 2000 to date (except for a short period where I lost access to some files in a move to new PC).
Sub ReColorSnapShot()
Dim Ranger As String
Dim LastCol As Long, lastRow As Long, ColorNum As Long
Dim SortRanger As Variant
Dim C As Long
Dim H As Long
Dim Quo As String
Dim YearNm As Variant, RGBnm As Variant
Quo = Chr(34)
Application.ScreenUpdating = True
Sheets("SnapShot").Activate
ActiveSheet.Unprotect
lastRow = Range("L99999").End(xlUp).Row
LastCol = 12
Range(Cells(2, 1), Cells(lastRow, LastCol)).Select
Selection.Interior.ColorIndex = False
Cells(2, 1).Select
YearNm = Array("2000", "2001", "2002", "2003", "2004", "2005", "2006", _
"2010", "2011", "2012", "2013", "2020", "2021", _
"2007", "2008", "2009", "2014", "2015", _
"2016", "2017", "2018", "2019", "2022", _
"2023", "2024", "1900")
RGBnm = Array(RGB(153, 204, 255), _
RGB(131, 241, 123), _
RGB(255, 153, 255), _
RGB(255, 255, 0), _
RGB(250, 191, 143), _
RGB(205, 216, 176), _
RGB(153, 204, 0), RGB(204, 255, 204), RGB(102, 204, 255), _
RGB(255, 204, 153), RGB(204, 192, 218), _
RGB(207, 183, 255), RGB(93, 174, 255), RGB(255, 128, 128), _
RGB(255, 204, 0), RGB(192, 192, 192), RGB(255, 255, 204), _
RGB(204, 204, 255), RGB(204, 255, 255), RGB(255, 102, 0), RGB(115, 120, 115), _
RGB(223, 184, 223), RGB(200, 181, 124), RGB(248, 54, 123), RGB(28, 155, 147), _
RGB(255, 255, 129)) '25'
For H = 0 To UBound(YearNm)
SortRanger = RGBnm(H)
For C = 2 To lastRow
Application.StatusBar = YearNm(H)
If Cells(C, LastCol).Text = YearNm(H) Then
If C Mod 2 = 0 Then
Sheets("SnapShot").Range(Cells(C, 1), Cells(C, LastCol)) _
.Interior.Color = SortRanger
Else
Sheets("SnapShot").Range(Cells(C, 1), Cells(C, LastCol)) _
.Interior.ColorIndex = False
End If
End If
Next C
Next H
Application.StatusBar = False
Cells(C - 10, 1).Select
ActiveSheet.Protect
YearNm = 0
RGBnm = 0
C = 0
MsgBox "Updated Snapshot Colors", vbInformation, "Done"
End Sub
In this example some years do not yet have an assigned color.
Some of the programming got a little messy. All in all, the initial coding took about an hour and debugging another hour or so.Here is an example of the spreadsheet that is read:
|