Hi Guys,
I wanted to ask you if someone can help me. I am completely new to VBA and tried this code that counts all my new projects set with the orange color and I have another row with names of employees and I want that VBA counts how many new project (with this color) have each employee.
Code:
Function CountCellColor(CountRange As Range, _
CountColor As Range, _
Optional IM As Variant) As Long
Dim Color As Long
Dim Total As Integer
Dim rCell As Range
Dim BOOL As Boolean
Color = CountColor.Interior.ColorIndex
For Each rCell In CountRange
If rCell.Interior.ColorIndex = Color Then
BOOL = False
If Not IsMissing(IM) Then
If IM = rCell.Offset(0, 1).Text Then BOOL = True
Else
BOOL = True
End If
If BOOL Then Total = Total + 1
End If
Next rCell
CountCellColor = Total
End Function
1. this is counting the total new projects: where Tabelle1 are the new projects with the background color and ColorProject C1 ist the color itself.
=CountCellColor(Tabelle1!$A:$A;ColorProject!$C$1)
2. counting how many new projects have each employee: List C1 is the name of one of the employee; C2 would be the next etc.
=CountCellColor(Tabelle1!$A:$A;ColorProject!$C$1;Lists!$C$1)
I could not attach the excel file . On my excel it is working but when I go to the work excel, it shows me correct the total number of the new projects but for each employee it shows me ZERO what is wrong.
I dont know where is the problem.
Thank you for you help!
I wanted to ask you if someone can help me. I am completely new to VBA and tried this code that counts all my new projects set with the orange color and I have another row with names of employees and I want that VBA counts how many new project (with this color) have each employee.
Code:
Function CountCellColor(CountRange As Range, _
CountColor As Range, _
Optional IM As Variant) As Long
Dim Color As Long
Dim Total As Integer
Dim rCell As Range
Dim BOOL As Boolean
Color = CountColor.Interior.ColorIndex
For Each rCell In CountRange
If rCell.Interior.ColorIndex = Color Then
BOOL = False
If Not IsMissing(IM) Then
If IM = rCell.Offset(0, 1).Text Then BOOL = True
Else
BOOL = True
End If
If BOOL Then Total = Total + 1
End If
Next rCell
CountCellColor = Total
End Function
1. this is counting the total new projects: where Tabelle1 are the new projects with the background color and ColorProject C1 ist the color itself.
=CountCellColor(Tabelle1!$A:$A;ColorProject!$C$1)
2. counting how many new projects have each employee: List C1 is the name of one of the employee; C2 would be the next etc.
=CountCellColor(Tabelle1!$A:$A;ColorProject!$C$1;Lists!$C$1)
I could not attach the excel file . On my excel it is working but when I go to the work excel, it shows me correct the total number of the new projects but for each employee it shows me ZERO what is wrong.
I dont know where is the problem.
Thank you for you help!