Solved

Excel - Total by Color (Not Using UDF)

Posted on 2014-12-23
4
170 Views
Last Modified: 2014-12-24
Hello Experts,

I would like to modify the code I came across, which sums all cells that have the same background color, please see attached file, with code.  I am using Excel 2010.  There are two limitations that this code has, which I've been trying to overcome for the past three weeks, but I cannot get it to work.

1. Color Index

By recording a macro in Excel 2010, where I colored cells at random, I noticed that the macro code made reference to the Selection.Interior.Pattern, *.PatternColorIndex, *.ThemeColor, *.TintAndShade, *.PatternTintAndShade instead of just the *.Interior.ColorIndex that the code I have attached in module 1 uses.  In a nutshell, I would like to match the cell background color of my target cell, see D25 in attached file and insert all the matching cell address "=+B13+B14...."

2. Range Of Cells

The second limitation that this code has is that it only applies to cells directly above the target cell, in the attached file, this cell is F25.  Ideally, the macro should prompt user to select range in which to look for the matching cells.
The cells will not be colored using conditional formatting, they'll be directly formatted using the fill color function.

The purpose of all this is for audit-trail purposes, and hence the need to list all cell addresses in one long formula.

Thank you very much for any help you can provide.
Sample-Data---Copy---Copy.xlsm
0
Comment
Question by:SuraDalbin
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
4 Comments
 
LVL 5

Expert Comment

by:Hakan Yılmaz
ID: 40516017
First, select the range you want to sum, and run this.
Sub AddColour()
    Dim iterCell As Range
    Dim SRow As Integer
    Dim SCol As Integer
    Application.Calculation = xlCalculationManual
    
    SRow = InputBox("Enter sum cell row")
    SCol = InputBox("Enter sum cell col")
    
    Cells(SRow, SCol).Formula = "="
    For Each iterCell In Selection
        If iterCell.Interior.Color = Cells(SRow, SCol).Interior.Color Then
            Cells(SRow, SCol).Formula = Cells(SRow, SCol).Formula & "+" & iterCell.Address
        End If
    Next iterCell
    Application.Calculation = xlCalculationAutomatic
End Sub

Open in new window

0
 

Author Comment

by:SuraDalbin
ID: 40516048
Hello Hakan,

Thank you very much for your response.  I tested the code, but on the first couple of attempts, it seems that the code enters the correct resulting formula in the (row, col) address that I entered in the inputboxes, overwriting the original value in that cell.  This cell however, was supposed to be included in that resulting formula.
To make it a bit more intuitive, can the code prompt the User for two range entries, one would be to select the range to be summed and the second entry would be to ask the User to select the cell that contains the color to be summed?

Thanks again,

Sura
0
 
LVL 5

Accepted Solution

by:
Hakan Yılmaz earned 500 total points
ID: 40516065
You can use this to write formula to multiple cells based on their colors.

e.g. make a cell green and make a cell red; select them as result cells. It will write sum formulas for both.

Sub AddColour()
    Dim resrange As Range
    Dim iterresrange As Range
    
    Dim sumrange As Range
    Dim itersumrange As Range

    Application.Calculation = xlCalculationManual
    
    Set sumrange = Application.InputBox("select cells you want to include in sums", , , , , , , 8)
    Set resrange = Application.InputBox("select cells you want to write formulas to", , , , , , , 8)
    
    For Each iterresrange In resrange
        iterresrange.Formula = "="
        For Each itersumrange In sumrange
            If itersumrange.Interior.Color = iterresrange.Interior.Color Then
                iterresrange.Formula = iterresrange.Formula & "+" & itersumrange.Address
            End If
        Next itersumrange
    Next iterresrange
    
    Application.Calculation = xlCalculationAutomatic
End Sub

Open in new window


RESULT
0
 

Author Closing Comment

by:SuraDalbin
ID: 40516114
Hakan,

Thank you so much, this works perfectly.  You rock!
0

Featured Post

Salesforce Has Never Been Easier

Improve and reinforce salesforce training & adoption using WalkMe's digital adoption platform. Start saving on costly employee training by creating fast intuitive Walk-Thrus for Salesforce. Claim your Free Account Now

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

635 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question