Colored cells operations

Antonescu

New Member
Joined
Feb 19, 2021
Messages
21
Office Version
  1. 365
Platform
  1. Windows
Hey, guys,

Could you please give me a hand with something. I am making a media plan and want to calculate the spend per week. The way it works is: I have multiple channels, spread by weeks and each channel has a budget. The days when I communicate through that channel, I manually color the cell (please see attached photo for the colored plan).

What I have is:
  • With the kind help of @Fluff, the VBA Code for the colored cells
Function IsCellColored(CellRange As Range) As Variant
Dim Result() As Variant
ReDim Result(1 To 1, 1 To CellRange.Cells.Count)
Dim i As Integer
i = 1
For Each rCell In CellRange
Result(1, i) = (rCell.Interior.ColorIndex <> xlNone)
i = i + 1
Next rCell
IsCellColored = Result
End Function

The desired outcome:
  • Budget per week, for cells B11, C11, D11. Now they are added manually. What it should be is something the likes of: B11 = SUM of IF IsCellColored(B5:B10), E5:E10 / F5:F10 * C4. Basically, the SUM of (BUDGET / active days * days in the week) for all the active channels in that week, but of course, only for the colored cells.
Thank you very much!

MAYBUDGETActive Days
Week15-2122-2829-31
DAYS773
Search€ 8,00017
Google Display€ 6,00014
Facebook€ 3,5007
Insta€ 7,00010
TikTok€ 3,50010
OOH0
BUDGET PER WEEK€ 12,244€ 11,194€ 4,562€ 28,000
 

Attachments

  • 1681387031321.png
    1681387031321.png
    14.7 KB · Views: 10

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
I have rewritten your IsCellColored function to give the result in an array with the same number of rows and columns as the input range.
Then it is easy to make a second function, where only those cells are summed whre the corresponding cell in the array is true
VBA Code:
Option Explicit



Function IsCellColored(CellRange As Range) As Variant
    Dim Result() As Variant
    Dim rCell As Range
    ReDim Result(1 To CellRange.Rows.Count, 1 To CellRange.Columns.Count)
    For Each rCell In CellRange
        Result(rCell.Row - CellRange.Row + 1, rCell.Column - CellRange.Column + 1) = (rCell.Interior.ColorIndex <> xlNone)
    Next rCell
    IsCellColored = Result
End Function



Function SumColoured(CellRange As Range) As Double
    Dim vUse As Variant
    Dim lR As Long, lC As Long, UB1 As Long, UB2 As Long
    
    UB1 = CellRange.Rows.Count
    UB2 = CellRange.Columns.Count
    
    vUse = IsCellColored(CellRange)
    
    For lR = 1 To UB1
        For lC = 1 To UB2
            If vUse(lR, lC) Then
                SumColoured = SumColoured + CellRange(lR, lC)
            End If
        Next lC
    Next lR
    
End Function
 
Upvote 0
Oh, yes: next time when you post code, do it in between code brackets. You should know this by now.
 
Upvote 0
Oh, yes: next time when you post code, do it in between code brackets. You should know this by now.
Thanks for the help! I don't doubt it's correct, however I couldn't verify it since it's exactly that final formula that I can't get right, which is the subject of this post. And, I apologize, I literally had no idea that code goes is brackets or how I should have had this information by now. This is the 3rd time ever I use code, and you're the first to mention this. But I will keep in mind, thanks!
 
Upvote 0
I will have a look at it. I see I forgot to read your post properly.
 
Upvote 0
Writing this UDF is more difficult than I expected: The reason is that one can't Range.Currentregion in a UDF (to be used in a spreadsheet).

So you will have to pass TWO ranges to the function: one is the range (column) with coloured cells, the other is the range holding the budget and active days.

mei23.xlsm
ABCDEF
1MayBudgetActive Days
2
3Week15-2122-2829-31
4Days773
5a800017
6b500014
7c120007
8d400010
9e500010
10f0
11budget per week8594.1217300.004111.76
Sheet9
Cell Formulas
RangeFormula
B11:D11B11=SumBudgetColoredCells(B5:B10,$E$5:$F$10)


The vba code for the UDF:
VBA Code:
Option Explicit

Function IsCellColored(CellRange As Range) As Variant
    Dim Result() As Variant
    Dim rCell As Range
    ReDim Result(1 To CellRange.Rows.Count, 1 To CellRange.Columns.Count)
    For Each rCell In CellRange
        Result(rCell.Row - CellRange.Row + 1, rCell.Column - CellRange.Column + 1) = (rCell.Interior.ColorIndex <> xlNone)
    Next rCell
    IsCellColored = Result
End Function


Function SumBudgetColoredCells(rColRange As Range, rBudgActD As Range) As Double
    Dim vUse As Variant, vBA As Variant
    Dim lR As Long, lC As Long, UB1 As Long, UB2 As Long, _
        lROffs As Long, lCOffs As Long, lSt As Long, lCBudg As Long, lCActD As Long
    Dim rDay As Range
    
    ' get row of DAY
    Set rDay = Range("A:A").Find(what:="DAYS")
    If Not rDay Is Nothing Then
        Set rDay = rDay.Offset(0, rColRange.Column - 1)
        Debug.Print rDay.Value
        
        UB1 = rColRange.Rows.Count
        UB2 = rColRange.Columns.Count
        
        vUse = IsCellColored(rColRange)
        For lR = 1 To UB1
            For lC = 1 To UB2
                If vUse(lR, lC) Then
                    SumBudgetColoredCells = SumBudgetColoredCells + (rBudgActD(lR, 1) / rBudgActD(lR, 2)) * rDay.Offset(0, lC - 1).Value
                End If
            Next lC
        Next lR
    Else
        SumBudgetColoredCells = Error(1)
    End If
        
End Function

The code is a bit rough. it does not check if the two ranges have the same number of rows for instance.
 
Upvote 0

Forum statistics

Threads
1,215,261
Messages
6,123,942
Members
449,134
Latest member
NickWBA

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top