sumif cell colour = white

[Sharp]

Hi,

this is the code i'm currently using to enter a formula into a cell

Sub ff()
Application.ScreenUpdating = False
Dim Rng As Range
ActiveSheet.Unprotect Password:="Password"
   For Each Rng In Range("b11:b500")
      If Rng.Value = "Total" Then
    
             Cells(Rng.Row, "af").Value = "=SUM" & "(?)" & Rng.Row
            
End If

However where i have the '?' i need it to basically say sum all the cells above until you get to a blue filled cell or a cell that is not white

any ideas

thanks

[Kenneth Hobson]

Are the interior colors due to a conditional format?

[Sharp]

Hi...no....just coloured using VBA code

[Kenneth Hobson]

Here is the way that I would do it. The 2nd Sub is just a dummy one to fill a sheet with some test data.

Sub TotalColB()
  Dim r As Range, c As Range, sumRange As Range
  Dim s As String, sRange As Range
  Dim j As Integer
  Dim fSum As String, a() As String
  Set r = Range("B11", Cells(Rows.Count, 2).End(xlUp))

  For Each c In r
    If c.Value = "Total" Then
      s = ""
      j = -1
      Do While c.Offset(j).Interior.ColorIndex <= 2
        s = s & "," & c.Offset(j, 0).Address
        j = j - 1
      Loop
      If s <> "" Then
        a() = Split(s, ",")
        fSum = "=Sum(" & a(1) & ":"
        If UBound(a) = 1 Then
          fSum = fSum & a(1) & ")"
          Else
            fSum = fSum & a(UBound(a)) & ")"
        End If
        Range("AF" & c.Row).Formula = fSum
      End If
    End If
  Next c
End Sub


Sub DummyData()
  Dim i As Integer, j As Integer, r As Range
  With [B11]
    .Value = "Widgets Sold"
    .Interior.ColorIndex = 24 'iceblue
    .Font.Bold = True
    .Columns.AutoFit
  End With
  
  For i = 12 To 100
    j = j + 1
    Set r = Range("B" & i)
    If i Mod 5 = 0 Then
      r.Value = "Total"
      r.Interior.ColorIndex = 24
      Else
      r.Value = j
      r.Interior.ColorIndex = xlNone  'white=2
    End If
  Next i
End Sub

[Sharp]

Genius...thats almost exaclty what i need.....

the only change is that i need the formula to sum the cells above where the formula is entered in AF...not the cells above the the 'total'

Also is is possible to change the interior colour reference to if white (2) or yellow (36)???

I've tried adapting the formual but with no success

your help is much appreciated.

thanks

[Kenneth Hobson]

Would column B have the value Total? If the colorindex is white or yellow in what column (AF?), and then sum? I would think that you would want to sum if the colorindex is xlNone which is a negative number as well.

Replace the Do line and the next with this might work:

Do While c.Offset(j, 30).Interior.ColorIndex = xlNone or _
  c.Offset(j, 30).Interior.ColorIndex = 2 or _
  c.Offset(j, 30).Interior.ColorIndex = 36
        s = s & "," & c.Offset(j, 30).Address

If you are checking the colorindex in Column B but summing from Column AF, then replace the three 30's in the Do line with 0.

[Sharp]

Hi,

thanks for this...it now sums the correct column and i played with the code so that it works on any colour......the last two bits i need is....

The user may enter three varitions of "Total", "total" or "TOTAL"....i can just copy the code three times and change the variation...but i think there must be a simple way to add 'or' into the VBA code??

Also...

I tried to adapt the code further as i need the sum formula to be repeated in columns AF,AG,AM,AN....i can get it to add the formula in, but i don't know how to get it to sum the columns above...at the moment they all sum the cells above AF??? I assume it will require a re-write of the code above the range.row line??

Here is my current code;

Sub TotalColB()
  Dim r As Range, c As Range, sumRange As Range
  Dim s As String, sRange As Range
  Dim j As Integer
  Dim fSum As String, a() As String
  Set r = Range("B1", Cells(Rows.Count, 2).End(xlUp))

  For Each c In r
    If c.Value = "Total" Then
      s = ""
      j = -1
      Do While c.Offset(j, 30).Interior.ColorIndex = xlNone
        s = s & "," & c.Offset(j, 30).Address
        j = j - 1
      Loop
      If s <> "" Then
        a() = Split(s, ",")
        fSum = "=Sum(" & a(1) & ":"
        If UBound(a) = 1 Then
          fSum = fSum & a(1) & ")"
          Else
            fSum = fSum & a(UBound(a)) & ")"
        End If
        Range("AF" & c.Row).Formula = fSum
        Range("Ag" & c.Row).Formula = fSum
        Range("Am" & c.Row).Formula = fSum
        Range("An" & c.Row).Formula = fSum
      End If
    End If
  Next c
End Sub

[Kenneth Hobson]

For the case issue:

If c.Value like "Total" Then

Would the sums of the other columns be the same rows? If so, you can copy the final sum formula from AF to those columns. We would need to set the Address to locals rather than absolute though.

e.g.

s = s & "," & c.Offset(j, 30).Address(False, False)

I would have to test a bit to see which copy method is best.

[Sharp]

Hi,

thanks for the reply,

the 'Like' function doesn't seem to work though??

The sum will be of the same rows....just in the different column

thanks for your continued help

[Kenneth Hobson]

Use LCase in that case...

Sub TotalColB()
  Dim r As Range, c As Range, sumRange As Range
  Dim s As String, sRange As Range
  Dim j As Integer
  Dim fSum As String, a() As String
  Set r = Range("B11", Cells(Rows.Count, 2).End(xlUp))


  For Each c In r
    If LCase(c.Value) = "total" Then
      s = ""
      j = -1
      Do While c.Offset(j, 30).Interior.ColorIndex = xlNone
        s = s & "," & c.Offset(j, 30).Address(False, False)
        j = j - 1
      Loop
      If s <> "" Then
        a() = Split(s, ",")
        fSum = "=Sum(" & a(1) & ":"
        If UBound(a) = 1 Then
          fSum = fSum & a(1) & ")"
          Else
            fSum = fSum & a(UBound(a)) & ")"
        End If
        Range("AF" & c.Row).Formula = fSum
        Range("AF" & c.Row).Copy Range("AG" & c.Row & ",AM" & c.Row & ",AN" & c.Row)
      End If
    End If
  Next c
End Sub