Checking colored cells using SUMPRODUCT - excel

I am trying to count the number of colored cells (which also satisfy another condition).
My cells are as follows:
My intention is to count the cells where there is a 'B' and where the adjacent cells are green in color.
I also write a function as follows:
Function CheckColor(rng As Range) As Boolean
If rng.Interior.ColorIndex = 43 Then
CheckColor = True
Else
CheckColor = False
End If
End Function
I then use SUMPRODUCT function as follows:
=SUMPRODUCT(--(V40:V50="B");--CheckColor(W40:W50))
However, I get an error #VALUE!
UPDATE
I have modified my formula as follows:
Function CheckColor(rng As Range) As Variant
Dim arr As Variant
Dim n As Integer
ReDim arr(0 To rng.Count - 1) As Variant
n = 0
For Each cell In rng
If cell.Interior.ColorIndex <> 43 Then
bl = False
Else
bl = True
End If
arr(n) = bl
n = n + 1
Next cell
CheckColor = arr
End Function
And I use the formula as follows:
=SUMPRODUCT((V40:V50="B")*CheckColor(W40:W50))
The answer I get is 6, which is wrong.

The arrays for column ranges are a bit different Variant(1 To 11, 1 To 1)
Function CheckColor(rng As Range)
Dim arr()
ReDim arr(1 To rng.Count, 1 To 1)
' arr = rng.Value2 ' arr Type in the Locals window shows as Variant(1 To 11, 1 To 1)
For i = 1 To rng.Cells.Count
arr(i, 1) = rng.Cells(i, 1).Interior.ColorIndex = 43
Next i
CheckColor = arr
End Function

You can do this without VBA, but you'll need a 'helper' column.
Create a named range with the name CellColour and the formula =GET.CELL(63,Sheet1!$B1)
Using your example (assuming it starts in cell A1), enter this formula in cells C1:C11: =CellColour. By the looks of your screen shot it should return 43 for green.
You can then use this formula to count column A with green in column B:
=COUNTIFS($A$1:$A$11,"B",$C$1:$C$11,43)
Background colour: How to count cells in a range with a value less than another cell in excel?
Font colour: Excel formula to get cell color

Edit, correction
In the function, you give the funtion a range and compare it to a ColorIndex. That means you ask if the whole range have the colorindex not the cells between.
What you do would work if Excel automaticly reference the right cells and compare them to the value, but i wouldn't do that for you.
So there are different ways you actually can manage this. First you do it without vba like Darren Bartrup-Cook meantion, you can do it with a helper column and write it like
=If(V40="B";CheckColor(W40)
And count the with Countif the true values or you write it in VBA but then you need to loop trough the cells one by one like this:
For x = 1 to 50
If Cells(x,10).Value = "b" AND Cells(x,11).ColorIndex = 43 Then
counter = counter + 1
Next x
Endif

Related

Excel VBA function to obtain positive values from a range

I have this Excel VBA function:
Function Positives(Rng As Range) As Range
Dim cell As Range, out As Range
For Each cell In Rng
If cell > 0 Then
If Not out Is Nothing Then
Set out = Union(out, cell)
Else
Set out = cell
End If
End If
Next cell
Set Positives = out
End Function
Why doesn't it work well when there are non-sequential positive numbers in Rng range? for example with values 5, 6, 7, -3, 4, 5 but values 5, 6, 7, -3, -4, -5 it works.
Thank you for your cooperation.
There is a limit for excel to display not consecutive range value using array function, see the comparison below
With consecutive range:
When it is not consecutive range
In your VBA code, when the result is in consecutive range, you will have no issue to display in array formula
When the result is not consecutive range, it return #Value as you mention, to solve this problem, one of the method is to change the result to display in string, hope you find it useful :)
Function Positives1(Rng As Range) As String
Dim cell As Range, out As Range, outCell As Range
Dim result As String
For Each cell In Rng.Cells
If cell.Value > 0 Then
If Not out Is Nothing Then
Set out = Union(out, cell)
Else
Set out = cell
End If
End If
Next cell
result = ""
For Each outCell In out.Cells
If result <> "" Then
result = result & "," & outCell.Value
Else
result = outCell.Value
End If
Next
Positives1 = result
End Function
if you want to return multiple values to multiple cells from a UDF to a sheet, you can do this using an array. Note that the best result will be when the dimensions of the call area and the return array match.
Option Explicit
Function Positives(Rng As Range) As Variant
Dim cell As Range, out As Variant, i As Long
ReDim out(1 To Rng.Cells.Count, 1 To 1) ' form the vertical array
For i = 1 To UBound(out, 1)
out(i, 1) = "no value" ' initial fill of the array
Next
i = 0
For Each cell In Rng
If cell > 0 Then
i = i + 1
out(i, 1) = cell
End If
Next cell
Positives = out
End Function

Ignore row if all 4 cells are 0; get name if any of the 4 cells is greater than 0

i have a list of names(Column A), the numbers in columns B to F are result of a formula. I'm trying to create a FOR LOOP code that will check columns B to F, if all cells in B to F are zero then the code should ignore the current row and skip to the next row; if any of the cells in columns B to F is greater than 0, then the code should get the corresponding name in Column A.
Example: If any of the cells in B2, C2, D2, and E2 is greater than 1, then i should get the name/value of A2. if all cells in B2, C2. D2, and E2 are all zeros, then proceed to check next row and do the same thing.
here's the code i used to try to get the names that has any of the 4 column cell values greater than 1
For i = 2 To LastCalcAnalystRowIndex '//wsCalculations.Cells(Rows.Count, "CP").End(xlUp).Row
'//Get Component from cell in column "BP"
Analyst = wsCalculations.Cells(i, "CP").Value
Component = wsCalculations.Cells(i, "CN").Value
weeknumber = wsCalculations.Range("BR2").Value + 3
If wsCalculations.Cells(i, "B").Value = 0 And wsCalculations.Cells(, "C").Value = 0 _
And wsCalculations.Cells(i, "D").Value = 0 And wsCalculations.Cells(i, "E").Value = 0 _
And wsCalculations.Cells(i, "F").Value = 0 Then
Exit For
Else
wsCalculations.Cells(i, "A").Value = wsCalculations.Cells(i, "CP").Value
End If
Next
using the code above, i tried to get the names which all 4 column values are not equal to zero, but the result i get is just a copy of the original list. i highlighted the rows i want my code to skip. i also included the result i get and the result i want to get.
Below is a sample data. My original data has 54 rows. .
can anyone please tell me what im getting wrong?
There's no real need for VBA.
Note that I have used a Table with structured references. You can change it to a range with normal references if you prefer.
If you have O365, you can use a helper column and a formula.
Add a helper column which SUM's the cells in each row (and you can hide that column if necessary).
eg: G2: =SUM(Table3[#[Column2]:[Column6]])
Then, assuming the data is in a Table named Table3 use the formula:
=INDEX(FILTER(Table3,Table3[sumRow]>0),0,1)
If you have an earlier version of Excel, you can use:
I2: =IFERROR(INDEX(Table3[Column1],AGGREGATE(15,6,1/(Table3[sumRow]>0)*ROW(Table3)-ROW(Table3[#Headers]),ROWS($1:1))),"")
and fill down the length of the table.
Not the solution but could shorten your initial code
Why not create a hidden column* that does an =SUM of the entire row
Then get the value from that
instead of using code to get the value of each 5 cells then adding it up.
edit: changed the 'hidden cell' to 'hidden column' :P
Try
Sub test()
Dim rngDB As Range
Dim rng As Range, rngSum As Range
Dim wsCalculations As Worksheet
Dim vR() As Variant
Dim n As Long
Set wsCalculations = ActiveSheet
With wsCalculations
Set rngDB = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
End With
For Each rng In rngDB
Set rngSum = rng.Offset(, 1).Resize(1, 5)
If WorksheetFunction.Sum(rngSum) > 0 Then
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = rng
End If
Next rng
With wsCalculations
If n Then
.Range("h2").Resize(n) = WorksheetFunction.Transpose(vR)
End If
End With
End Sub
can anyone please tell me what im getting wrong?
actually your shown code isn't consistent with your wording, so it's impossibile to tell all that's wrong
but for sure that Exit For is a logical error, since it actually gets you out of the loop when it first meets five zeros
so as far as this logical error is concerned, you should change that piece fo code to the following:
With wsCalculations
For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountIf(.Cells(i, 2).Resize(, 5), 0) < 5 Then ' when a row is eligible for math
' do your math
End If
Next
End With
where I used WorksheetFunction.CountIf() function that enables you to deal with different conditions since your wording wasn't clear about this item, too ("greater than 0", "all cells...are zero", "greater than 1")

excel COUNTIF Count Words with a Cell Background Option

Is it possible to use the CountIf function with advanced options: count cells containing a specific string only if the cell background is of a specific color.
I'm using the Excel formula: `=COUNTIF(page001!B:B;"id-p01"), but blocks of data on each sheet have unique strings, each block could have two different background colors: GREEN or BLUE. So what i'm asking is if i can get a function which would e.g. COUNT cells containing "id-p01" on a selected sheet, but ONLY those with a GREEN background color.
Here is an example of how the sheet looks like:
With this formula: =COUNTIF(page001!B:B;"*id-p01*")
It counts id-p01 on the selected sheet in the B:B column.
Is it possible to make it count only GREEN background colored cells?
This quick solution will print out on the screen the number of cells within the Range B1 to B1000 (you can modify the Range if you've more/less rows to test) that have exactly your green color.
Note that you have to use a macro to do this, it can't be achieved with a simple formula.
To create a macro, press ALT + F11, then right-click on your Workbook's name and "Insert Module". Copy paste the code below and press F5 while you're still in the VBA window or use any other method to run the macro.
Sub CountWithColor()
For Each c In Range("B1:B1000")
If c.Value Like "*id-p01*" And c.Interior.Color = RGB(226, 239, 218) Then
compteur = compteur + 1
End If
Next c
MsgBox (compteur)
End Sub
Let me know if this helped.
Eleove
Count If Value And Color
Function CIVAC(Range As Range, Value As Variant, _
Optional ColorIndex As Long = -4142, _
Optional Compare As Integer = 1) As Long
'Title
'Count If Value And Color
'Description
'In a specified contiguous range, counts the number of cells both,
'containing a specified value and having a specified Interior ColorIndex.
Dim arrVal As Variant 'Range Array
Dim arrClr() As Long 'ColorIndex Array
Dim lngVal As Long 'Row Counter
Dim iVal As Integer 'Column Counter
Dim lngResult As Long 'Result Accumulator
'Values
arrVal = Range.Areas(1) 'Prevent Multiple Areas Error
'ColorIndexes
ReDim arrClr(LBound(arrVal) To UBound(arrVal), _
LBound(arrVal, 2) To UBound(arrVal, 2))
For lngVal = LBound(arrClr) To UBound(arrClr)
For iVal = LBound(arrClr, 2) To UBound(arrClr, 2)
arrClr(lngVal, iVal) = Range.Cells(lngVal, iVal).Interior.ColorIndex
Next
Next
'Count
For lngVal = LBound(arrClr) To UBound(arrClr)
For iVal = LBound(arrClr, 2) To UBound(arrClr, 2)
If Not IsError(arrVal(lngVal, iVal)) Then 'Prevent VBA Errors
If InStr(1, arrVal(lngVal, iVal), Value, Compare) <> 0 And _
arrClr(lngVal, iVal) = ColorIndex Then lngResult = lngResult + 1
End If
Next
Next
CIVAC = lngResult
End Function
That's nice, but what's the 'Interior ColorIndex' of the color in this cell?
Cell Interior Color Index
Function CICI(CellRange As Range) As Long
'Title
'Cell Interior Color Index
'Description
'Returns the Interior ColorIndex of a specified cell ('CellRange').
'If 'CellRange' contains more than one cell, it uses the first cell.
CICI = CellRange(1, 1).Interior.ColorIndex
End Function

Excel VBA manipulate array data

I have 2 worksheets, Main and Return. I have the values in Main and the results in Return. I am trying to find a particular position in an array containing an index value (the data comes from Main sheet) e.g. 10, 20, 40, 50, 60 etc...then take the 5 values above and 5 values below this index including the index value I am searching for and do an average of it returning the average to a cell on the sheet (to the Return sheet), thus doing an average of 11 values. So far I have managed to store the range in the array using:
Public Sub myArray()
Dim myArr() As Variant
Dim R As Long
Dim C As Long
myArr = Range("C6:D1126")
For R = 1 To UBound(myArr, 1)
For C = 1 To UBound(myArr, 2)
Debug.Print myArr(R, C)
Next C
Next R
End Sub
The search/find of value within the array and averaging has left me scratching my head...
Please help...thank you. Help with the code in the array or manipulating the data from the worksheet itself works fine by me :)
Sample file --> http://www.filedropper.com/indexes
You could use this UDF:
Function avrg(indx, rng As Range)
Dim i, minI As Long, maxI As Long
i = Application.Match(indx, rng.Columns(2), 0)
If IsError(i) Then
avrg = CVErr(xlErrNA)
Exit Function
End If
With WorksheetFunction
minI = .Max(1, i - 5)
maxI = .Min(rng.Rows.Count, i + 5)
avrg = .Average(rng.Cells(1, 1).Offset(minI - 1).Resize(maxI - minI + 1))
End With
End Function
This UDF finds first entry of value (say 10 or 20) in Index column (Main sheet) takes 5 values above and 5 below it and returns average of corresponding values of column Value (Main sheet). If you need to take average of values from column Index, change rng.Cells(1, 1) to rng.Cells(1, 2)
Also note at this lines in UDF:
minI = .Max(1, i - 5)
maxI = .Min(rng.Rows.Count, i + 5)
if we can't take 5 values below and 5 values above index i (e.g. if index of target value equals to 2) we take in first case all values from start and in second case all values untill end of range.
Then you can call it either from worksheet: enter this formula in sheet Dash cell C4: =avrg(C3,Main!$C$6:$D$1126) and drag it across.
either from VBA:
Sub test()
Dim rng As Range
Dim rngInd As Range
Dim cell As Range
Set rng = ThisWorkbook.Worksheets("Main").Range("C6:D1126")
Set rngInd = ThisWorkbook.Worksheets("Dash").Range("C3:L3")
For Each cell In rngInd
cell.Offset(1).Value = avrg(cell.Value, rng)
Next cell
End Sub
In both cases function returns #N/A if indx value not found.

Sum cells based on colour and date

I have the following:
Date ------- Cost
Jan £500
Jan £600
Feb £300
Feb £600
March £1000
March £500
The cost cells are coloured differently depending on its current status (confirmed green, unconfirmed white, semi-confirmed yellow), I need a formula to sum all costs that are for example, green and in February.
I'm aware VBA is required for this sort of colour function, and have found a useful one called colorfunction() that allows me to sum/count cells of colours using the following formula:
colorfunction(A1, B1:B5, FALSE)
A1 being the colour to compare the range against, and FALSE / TRUE returning the sum or count result.
However I cannot work this custom function into a MONTH() formula or SUMIF.
I could be completely over-complicating this so please point out any idiotic mistakes I'm making in trying to figure this out.
Add this Function to your VBA module in order to return a cells interior color index:
Function ColorIndex(rng As Range, _
Optional text As Boolean = False) As Variant
Dim cell As Range, row As Range
Dim i As Long, j As Long
Dim iWhite As Long, iBlack As Long
Dim aryColours As Variant
If rng.Areas.Count > 1 Then
ColorIndex = CVErr(xlErrValue)
Exit Function
End If
iWhite = WhiteColorindex(rng.Worksheet.Parent)
iBlack = BlackColorindex(rng.Worksheet.Parent)
If rng.Cells.Count = 1 Then
If text Then
aryColours = DecodeColorIndex(rng, True, iBlack)
Else
aryColours = DecodeColorIndex(rng, False, iWhite)
End If
Else
aryColours = rng.Value
i = 0
For Each row In rng.Rows
i = i + 1
j = 0
For Each cell In row.Cells
j = j + 1
If text Then
aryColours(i, j) = _
DecodeColorIndex(cell, True, iBlack)
Else
aryColours(i, j) = _
DecodeColorIndex(cell, False, iWhite)
End If
Next cell
Next row
End If
ColorIndex = aryColours
End Function
Private Function WhiteColorindex(oWB As Workbook)
Dim iPalette As Long
WhiteColorindex = 0
For iPalette = 1 To 56
If oWB.Colors(iPalette) = &HFFFFFF Then
WhiteColorindex = iPalette
Exit Function
End If
Next iPalette
End Function
Private Function BlackColorindex(oWB As Workbook)
Dim iPalette As Long
BlackColorindex = 0
For iPalette = 1 To 56
If oWB.Colors(iPalette) = &H0 Then
BlackColorindex = iPalette
Exit Function
End If
Next iPalette
End Function
Private Function DecodeColorIndex(rng As Range, _
text As Boolean, _
idx As Long)
Dim iColor As Long
If text Then
iColor = rng.Font.ColorIndex
Else
iColor = rng.Interior.ColorIndex
End If
If iColor < 0 Then
iColor = idx
End If
DecodeColorIndex = iColor
End Function
Then to get the count of all cells with the color index of 14 (Green) use sumproduct as Follows:
=SUMPRODUCT(--(ColorIndex(B1:B100000)=14),B1:B100000)
This will return the sum of all cells in Range B1:B100000 with a Color of 14 (Green)
The Final example should look something like this:
Additionally if you prefer Sumifs over Sumproduct yopu have the option of using a helper Column. In the Column next to the Cost enter =ColorIndex(B1) and then drag down
Then in another cells Enter the Formula
=SUM(SUMIFS(B1:B10,C1:C10,14,A1:A10,{"FEB","MARCH"}))
Replacing the Months with the Months you'd like to sum (your oringal Title indicates this is your End goal).
This will sum the Cost values where the helper Row says the index is 14(Green) AND the month is either Feb or March
I realize you are asking for a programing answer, and I have no idea of the scope of your project.
Here is simple solution, without programing.
Filter by color, select the cells, the sum will be displayed at the bottom (i.e. 2100)

Resources