Conditionally Format cells in a row based on the sum of the previous nth cells.

[elcid7236]

Team,

I am using MS EXCEL 2010.

I have a spreadsheet where I am trying to conditionally format certain cells. Row 6 (Column A to NB) has values from 0.0 to 20.0. I want to format cell AJ8 using the formula, Sum(AD6:AJ6)>=56 (Fill the cell with the color Pink (RGB:255, 192, 203). Then in cell AK8 using the formula, Sum(AE6:AK6)>=56 (Fill the cell with the color Pink (RGB:255, 192, 203). etc...Basically I want the format to use the sum of the previous 7 cells of data.

Then I want to format cell AJ8 using the formula, Sum(W6:AJ6)>=80 (Fill the cell with the color Red (RGB:255, 0, 0). Then in cell AK8 using the formula, Sum(X6:AK6)>=80 (Fill the cell with the color Red(RGB:255, 0, 0). Basically I want the format to use the sum of the previous 14 cells of data.


Then I want to format cell AJ8 using the formula, Sum(G6:AJ6)>=80 (Fill the cell with the color Blue(RGB:0, 0, 255). Then in cell AK8 using the formula, Sum(H6:AK6)>=80 (Fill the cell with the color Blue(RGB:0, 0, 255). Basically I want the format to use the sum of the previous 30 cells of data.

Rows 8 through 200 (rows 6, 11, 16, 21, 26,etc... have the values) (Rows 8,13,18,23,28,33,38,etc... needs the fill of the cell to be formatted). I need the fill of the cells to format with a particular color if the sum of the previous 7 cells are >= 56, and another color if the sum of the previous 14 cells are >= 80, and another color if the sum of the previous 30 cells are >= 100, and another color if the sum of the previous 30 cells are >= 120.

This is four of the conditions i need. I would like to do this in VBA because I need 6 conditions for each cell. I need a total of six, but if I can get the first four, I think I can modifiy the code to do the last two.

Thank you in advance.

[SamT]

Option Explicit

Sub SamT_CustomFormat()
Dim Rw As Long
Dim LastRow As Long

Enum Cv_ColorValues
  cvPink = RGB(255, 192, 203)
  cvRed = RGB(255, 0, 0)
  cvBlue = RGB(0, 0, 255)
End Enum

LastRow = Cells(RowCount, 1).End(xlUp).Row
For Rw = 6 To LastRow Step 5

    'Check first SUM
    If Sum(Range("AD" & Rw & ":AJ" & Rw)) >= 56 Then
      Range("AJ" & Rw + 2).Interior.Color = cvPink
    Else
      Range("AJ" & Rw + 2).Interior.ColorIndex = xlColorIndexNone
    End If
    
    'Check Second Sum
    If Sum(Range("AE" & Rw & ":AK" & Rw)) >= 56 Then
      Range("AK" & Rw + 2).Interior.Color = cvPink
    Else
      Range("AK" & Rw + 2).Interior.ColorIndex = xlColorIndexNone
    End If
    
    'Change Columns, values, and colors below as needed
    
    If Sum(Range("AD" & Rw & ":AJ" & Rw)) >= 56 Then
      Range("AJ" & Rw + 2).Interior.Color = cvBlue
    Else
      Range("AJ" & Rw + 2).Interior.ColorIndex = xlColorIndexNone
    End If
    
    If Sum(Range("AE" & Rw & ":AK" & Rw)) >= 56 Then
      Range("AK" & Rw + 2).Interior.Color = cvRed
    Else
      Range("AK" & Rw + 2).Interior.ColorIndex = xlColorIndexNone
    End If
    
    If Sum(Range("AD" & Rw & ":AJ" & Rw)) >= 56 Then
      Range("AJ" & Rw + 2).Interior.Color = cvPink
    Else
      Range("AJ" & Rw + 2).Interior.ColorIndex = xlColorIndexNone
    End If
    
    If Sum(Range("AE" & Rw & ":AK" & Rw)) >= 56 Then
      Range("AK" & Rw + 2).Interior.Color = cvBlue
    Else
      Range("AK" & Rw + 2).Interior.ColorIndex = xlColorIndexNone
    End If
    
    If Sum(Range("AE" & Rw & ":AK" & Rw)) >= 56 Then
      Range("AK" & Rw + 2).Interior.Color = cvRed
    Else
      Range("AK" & Rw + 2).Interior.ColorIndex = xlColorIndexNone
    End If

Next Rw

End Sub

[elcid7236]

I just received an email with your reply. Thank you for the reply...I copied and pasted the code inside my worksheet using the Private Sub Worksheet_Activate() and when I opened the spreadsheet, I received the error "Compile error: Invalid inside procedure. The following line of code was highlited.

Enum Cv_ColorValues

Also, I apologize for not being more specific with the starting and ending columns. The data colums are basically the calendar days for a whole year. Column G is Jan 1 and Column NG is Dec 31.
A number is entered every day in Row 6, 11, 16, 21, 26 etc to row 171. Column AJ (Jan 30) was an example. I have never used Enum before and am not sure how to proceed.

[snb]

see the attachment,

[elcid7236]

I modified the code and now it works great... Many thanks

I modified the following code:
LastRow = Cells(RowsCount, 1).End(xlUp).Row to For Rw = 6 To 171 Step 5

Sum(Range("AD" & Rw & ":AJ" & Rw)) >= 56 to Application.WorksheetFunction.Sum(Range("AD" & Rw & ":AJ" & Rw)) >= 56 Then

Enum Cv_ColorValues
cvPink = RGB(255, 192, 203)
cvRed = RGB(255, 0, 0)
cvBlue = RGB(0, 0, 255)
End Enum

to
Dim strPink As String
Dim strBlue As String
Dim strRed As String

'Enum Cv_ColorValues
strPink = RGB(255, 192, 203)
strRed = RGB(255, 0, 0)
strBlue = RGB(0, 0, 255)
'End Enum

[SamT]

OR you could have moved the Enum section to before the Sub declaration. That is what the "Compile error: Invalid inside procedure" meant. Enum was inside the Sub.

The purpose of Enum is to provide a quick way to declare a bunch of related constants. All Enumerated Variables are Data Type Long, so I didn't need to specifically assign a Data Type to them.

Yet another method, which can be inside a procedure (Sub or Function) is the use of Constants:

Const strPink As Long = RGB(255, 192, 203)
Const strRedAs Long = RGB(255, 0, 0)
Const strBlue As Long = RGB(0, 0, 255)

BTW, when you declared the color variables as Strings, you forced VBA to convert the output of the RGB function from a Long Data Type to a String Data Type, then when you assign the Cells' Interior.Color to the color variable, you forced VBA to convert it from a String Data Type back to a Long Data Type.

[elcid7236]

SamT,

Again, Thank you for the code...you have saved me alot of frustrating hours...is it possible to shorten this code even more? here is a sample of what I am doing.

I am looking to do a For...Next loop with the columns. Otherwise, I am writing 362 more iterations of this code. I have 4 right now. As you can see, in each iteration I change the column by one letter.

Any help is always appreciated.

Elcid

Dim Rw As Long
Dim strSteel As String
Dim strRed As String
Dim strYellow As String
Dim strPink As String
Dim strOrange As String
Dim strMajenta As String
Dim strGreen As String

strSteel = RGB(184, 204, 228)
strRed = RGB(255, 0, 0)
strYellow = RGB(255, 255, 0)
strPink = RGB(255, 192, 203)
strOrange = RGB(228, 108, 10)
strMajenta = RGB(204, 0, 255)
strGreen = RGB(0, 204, 0)

' ********************* Column "G" to "NG" *************************
For Rw = 6 To 171 Step 5
'first group of conditional formatting
If Application.WorksheetFunction.Sum(Range("G" & Rw & ":I" & Rw)) >= 30 Then
Range("I" & Rw + 2).Interior.Color = strGreen
End If
If Application.WorksheetFunction.Sum(Range("G" & Rw & ":M" & Rw)) >= 56 Then
Range("M" & Rw + 2).Interior.Color = strMajenta
End If
If Application.WorksheetFunction.Sum(Range("G" & Rw & ":T" & Rw)) >= 70 Then
Range("T" & Rw + 2).Interior.Color = strOrange
End If
If Application.WorksheetFunction.Sum(Range("G" & Rw & ":T" & Rw)) >= 80 Then
Range("T" & Rw + 2).Interior.Color = strPink
End If
If Application.WorksheetFunction.Sum(Range("G" & Rw & ":AJ" & Rw)) >= 110 Then
Range("AJ" & Rw + 2).Interior.Color = strYellow
End If
If Application.WorksheetFunction.Sum(Range("G" & Rw & ":AJ" & Rw)) >= 120 Then
Range("AJ" & Rw + 2).Interior.Color = strRed
End If

'second group of conditional formatting

If Application.WorksheetFunction.Sum(Range("H" & Rw & ":J" & Rw)) >= 30 Then
Range("J" & Rw + 2).Interior.Color = strGreen
End If
If Application.WorksheetFunction.Sum(Range("H" & Rw & ":N" & Rw)) >= 56 Then
Range("N" & Rw + 2).Interior.Color = strMajenta
End If
If Application.WorksheetFunction.Sum(Range("H" & Rw & ":U" & Rw)) >= 70 Then
Range("U" & Rw + 2).Interior.Color = strOrange
End If
If Application.WorksheetFunction.Sum(Range("H" & Rw & ":U" & Rw)) >= 80 Then
Range("U" & Rw + 2).Interior.Color = strPink
End If
If Application.WorksheetFunction.Sum(Range("H" & Rw & ":AK" & Rw)) >= 110 Then
Range("AK" & Rw + 2).Interior.Color = strYellow
End If
If Application.WorksheetFunction.Sum(Range("H" & Rw & ":AK" & Rw)) >= 120 Then
Range("AK" & Rw + 2).Interior.Color = strRed
End If

'third group of conditional formatting

If Application.WorksheetFunction.Sum(Range("I" & Rw & ":K" & Rw)) >= 30 Then
Range("K" & Rw + 2).Interior.Color = strGreen
End If
If Application.WorksheetFunction.Sum(Range("I" & Rw & ":O" & Rw)) >= 56 Then
Range("O" & Rw + 2).Interior.Color = strMajenta
End If
If Application.WorksheetFunction.Sum(Range("I" & Rw & ":V" & Rw)) >= 70 Then
Range("V" & Rw + 2).Interior.Color = strOrange
End If
If Application.WorksheetFunction.Sum(Range("I" & Rw & ":V" & Rw)) >= 80 Then
Range("V" & Rw + 2).Interior.Color = strPink
End If
If Application.WorksheetFunction.Sum(Range("I" & Rw & ":AL" & Rw)) >= 110 Then
Range("AL" & Rw + 2).Interior.Color = strYellow
End If
If Application.WorksheetFunction.Sum(Range("I" & Rw & ":AL" & Rw)) >= 120 Then
Range("AL" & Rw + 2).Interior.Color = strRed
End If

'fourth group of conditional formatting

If Application.WorksheetFunction.Sum(Range("I" & Rw & ":K" & Rw)) >= 30 Then
Range("K" & Rw + 2).Interior.Color = strGreen
End If
If Application.WorksheetFunction.Sum(Range("I" & Rw & ":O" & Rw)) >= 56 Then
Range("O" & Rw + 2).Interior.Color = strMajenta
End If
If Application.WorksheetFunction.Sum(Range("I" & Rw & ":V" & Rw)) >= 70 Then
Range("V" & Rw + 2).Interior.Color = strOrange
End If
If Application.WorksheetFunction.Sum(Range("I" & Rw & ":V" & Rw)) >= 80 Then
Range("V" & Rw + 2).Interior.Color = strPink
End If
If Application.WorksheetFunction.Sum(Range("I" & Rw & ":AL" & Rw)) >= 110 Then
Range("AL" & Rw + 2).Interior.Color = strYellow
End If
If Application.WorksheetFunction.Sum(Range("I" & Rw & ":AL" & Rw)) >= 120 Then
Range("AL" & Rw + 2).Interior.Color = strRed
End If

Next Rw

[snb]

1 why don't you use Excel's builtin conditional formatting (why would MS have invented this in the first place ?)
2 can you please, I repeat please, use code tags around VBA code in this forum ?

[SamT]

IF my head is wrapped rightly, this should do it. Oops!

Note that you won't want to be running this thing against the entire sheet every time a new day comes along. After you have the sheet formatted to date, Change this to a Worksheet Change Event sub, set Rw to Target.Row and loose the Row looping. IOW, just run it against the one row.

Sub

 SamT()
'Range.Interior.Color accepts Variants.
'Declare following constants as Variant Data Type
'Variant is default Data Type, don't need to explicitly use.
    Const vSteel = RGB(184, 204, 228)
    Const vRed = RGB(255, 0, 0)
    Const vYellow = RGB(255, 255, 0)
    Const vPink = RGB(255, 192, 203)
    Const vOrange = RGB(228, 108, 10)
    Const vMajenta = RGB(204, 0, 255)
    Const vGreen = RGB(0, 204, 0)

'Declare Row and column counters
Dim Rw As Long, Col As Long

'Declare Column PlaceHolders
Dim G As Long, I As Long, M As Long, T As Long, AJ As Long

'Following assumes that only 165 Rows, (33 days) are used in a year
'Step thru the rows
For Rw = 6 To 171 Step 5
  
'Step thru the columns
  For Col = 7 To 335 'Adjust 335 as needed
  G = Col
  
'Set values of other column placeholders. Will Follow G thru the Columns
  I = G + 2 'You only need to get these right once.
  M = G + 6
  T = G + 13
  AJ = G + 29
    
'We're now using Cells instead of Range addresses in order to use variables
    'A new code syntax for your education. See underscore at end of lines.
    If Application.WorksheetFunction.Sum(Range(Cells(Rw, G), Cells(Rw, I))) >= 30 Then _
          Cells(Rw + 2, I).Interior.Color = vGreen
    If Application.WorksheetFunction.Sum(Range(Cells(Rw, G), Cells(Rw, M))) >= 56 Then _
          Range(Rw + 2, M).Interior.Color = vMajenta
    
    'Check in Descending order to avoid double work.
    If Application.WorksheetFunction.Sum(Range(Cells(Rw, G), Cells(Rw, T))) >= 80 Then
          Cells(Rw + 2, T).Interior.Color = vPink
    ElseIf Application.WorksheetFunction.Sum(Range(Cells(Rw, G), Cells(Rw, T))) >= 70 Then
          Cells(Rw + 2, T).Interior.Color = vOrange
    End If
    
    'Check in Descending order to avoid double work.
    If Application.WorksheetFunction.Sum(Range(Cells(Rw, G), Cells(Rw, AJ))) >= 120 Then
          Cells(Rw + 2, AJ).Interior.Color = vRed
    ElseIf Application.WorksheetFunction.Sum(Range(Cells(Rw, G), Cells(Rw, AJ))) >= 110 Then
          Cells(Rw + 2, AJ).Interior.Color = vYellow
    End If
Next Col

Next Rw

End Sub

[elcid7236]

I apologize for not using the tags...won't happen again....Thank you very much for your dedication to helping those who don't know what they are doing (like me).

[snb]

@SamT

equivalents:

Application.WorksheetFunction.Sum(Range

Application.Sum(Range

[SamT]

[snb]

Sub M_snb()
  With Sheets(1)
    For j = 6 To 171 Step 5
      For jj = 7 To 335 'Adjust 335 as needed
          If Application.Sum(.Cells(j, jj).Resize(, 2)) >= 30 Then c00 = c00 & "," & .Cells(j + 2, jj + 2).Address
          If Application.Sum(.Cells(j, jj).Resize(, 6)) >= 56 Then c01 = c01 & "," & .Cells(j + 2, jj + 6).Address
      
          If Application.Sum(.Cells(j, jj).Resize(, 13)) >= 80 Then
            c02 = c02 & "," & .Cells(j + 2, jj + 13).Address
          ElseIf Application.Sum(.Cells(j, jj).Resize(, 13)) >= 70 Then
            c03 = c03 & "," & .Cells(j + 2, jj + 13).Address
          End If
      
          If Application.Sum(.Cells(j, jj).Resize(, 29)) >= 120 Then
            c04 = c04 & "," & .Cells(j + 2, jj + 29).Address
          ElseIf Application.Sum(.Cells(j, jj).Resize(, 29)) >= 110 Then
            c05 = c05 & "," & .Cells(j + 2, jj + 29).Address
          End If
      Next
    Next
      
    For j = 1 To 6
      .Range(Mid(Choose(j, c00, c01, c02, c03, c04, c05), 2)).Interior.Color = Choose(j, RGB(0, 204, 0), RGB(204, 0, 255), RGB(255, 192, 203), RGB(228, 108, 10), RGB(255, 0, 0), RGB(255, 255, 0))
    Next
  End With
End Sub

[SamT]

@SNB

What first character are you excluding in the range addresses?

Mid(Choose(j, c00, c01, c02, c03, c04, c05), 2)

[snb]

a comma

c05 = c05 & "," & .Cells(j + 2, jj + 29).Address

c05=",A1,A3,A4"

[SamT]

Thanks