Fill cell values on Interiorcolor conditions

[u473]

Having Sheet1 containing number of people per Resource and Week,
Sheet2 Range E2:I10 contains number of hours per Resource and week
based on interiorcolor and forecolor of each Cell in Sheet1 Range
E2:I10
InteriorColor = None = 8 hours per day RGB 255,255,255
InteriorColor = Light Green = 9 hours per day RGB 153,255,153
InteriorColor = Light Yellow = 10 hours per day RGB 255,255,102
ForeColor = Black = 5 days a week ColorIndex 1
ForeColor = Blue = 6 days a week ColorIndex 5
ForeColor = Red = 7 days a week ColorIndex 3
Sheet3 Range E2:I10 contains Cost per Resource and Week
Based on Hours in Sheet2 Range E2:I10 * Average Rate in Sheet1 Range
B2:B10
Sheet1 Range C2:C10 contains Total Hours per Resource from Sheet2
Range E2: I10
Sheet1 Range D210 contains Total Cost per Resource from Sheet3 Range
E2 : I10
Sheet1 header is as follows :
Resource, AvgRate, Hours, Cost, Week1, Wk2, Wk3, Wk4, Wk5
Aside from my syntax needing correction, how will I address my
variable
iCol for Cell Interiorcolor if it is not a ColorIndex value but an RGB
value ?
---- Pseudo Code --------------
Sub Cost()
Dim ws1,ws2, ws3 as Worksheets
Dim rng as Range
Dim iCol as ? ' InteriorColor
Dim fCol as Integer ' forecolor
Dim AvgRate as Integer
Set rng as Range(E2:I10)
set ws1 as ThisWorksheet

--------------------------------------------------------------
For Each Cell in rng
AvgRate = ActiveCell(Row,"B")
iCol = ActiveCell.Interiorcolor : fCol = ActiveCell.Forecolor
Select Case iCol
Case is …. ' Light Green
Select Case fColor
Case 5 ' Blue
ws2.ActiveCell.value = ws1.ActiveCell.Value * 9 *
6
ws3.ActiveCell.value = ws1.ActiveCell.Value * 9 *
6 * AvgRate
Case 3 ' Red
ws2.ActiveCell.value = ws1.ActiveCell.Value * 9 *
7
ws3.ActiveCell.value = ws1.ActiveCell.Value * 9 *
7 * AvgRate
Case Else ' Black
ws2.ActiveCell.value = ws1.ActiveCell.Value * 9
* 5
ws3.ActiveCell.value = ws1.ActiveCell.Value * 9
* 5 * AvgRate
End Select
Case is …. ' Light Yellow
Select Case fColor
....
Case Else
....
End Select
Next Cell
'Sum Hours from ws2 to ws1 Column "C"
Set rng as Range(C2:C10)
For Each Cell in rng
Sum ws2(Row:"E:I")
Next Cell
'Sum Cost from ws3 to ws1 Column "D"
Set rng as Range(D210)
For Each Cell in rng
Sum ws3(Row:"E:I")
Next Cell
End Sub

Thank you for your help

Celeste

 

[u473]

I resolved it by myself, it works and I am quite happy about it.
I could probably simplify it but that will be the next step.
One question remains, the ColorIndex of Black is 1 and White is 2.
To make my program work, I had to find that Black is -4105 and White
is -4142 ?
Where was I supposed to find this ?

Sub ColorTest()
Dim rng As Range: Dim iClr As Integer: Dim fClr As Integer
Dim Men As Integer
Set rng = Range("B2:F2"): Range("B2").Select
For Each Cell In rng
iClr = ActiveCell.Interior.ColorIndex: Men = Cell.Value
fClr = ActiveCell.Font.ColorIndex
Select Case iClr
Case 40
If fClr = -4105 Then
ActiveCell.Offset(1, 0).Value = Men * 5 * 9
ElseIf fClr = 5 Then
ActiveCell.Offset(1, 0).Value = Men * 6 * 9
Else
ActiveCell.Offset(1, 0).Value = Men * 7 * 9
End If
Case 36
If fClr = -4105 Then
ActiveCell.Offset(1, 0).Value = Men * 5 * 10
ElseIf fClr = 5 Then
ActiveCell.Offset(1, 0).Value = Men * 6 * 10
Else
ActiveCell.Offset(1, 0).Value = Men * 7 * 10
End If
Case 34
If fClr = -4105 Then
ActiveCell.Offset(1, 0).Value = Men * 5 * 11
ElseIf fClr = 5 Then
ActiveCell.Offset(1, 0).Value = Men * 6 * 11
Else
ActiveCell.Offset(1, 0).Value = Men * 7 * 11
End If
Case 39
If fClr = -4105 Then
ActiveCell.Offset(1, 0).Value = Men * 5 * 12
ElseIf fClr = 5 Then
ActiveCell.Offset(1, 0).Value = Men * 6 * 12
Else
ActiveCell.Offset(1, 0).Value = Men * 7 * 12
End If
Case Else
If fClr = -4105 Then
ActiveCell.Offset(1, 0).Value = Men * 5 * 8
ElseIf fClr = 5 Then
ActiveCell.Offset(1, 0).Value = Men * 6 * 8
Else
ActiveCell.Offset(1, 0).Value = Men * 7 * 8
End If
End Select
ActiveCell.Offset(0, 1).Select
Next Cell
End Sub

 

[Norman Jones]

Hi U473.

For most color topics, the first port of call
should be Chip Pearson's Color pages:

http://www.cpearson.com/excel/colors.aspx

To list the 56 colours from the current
workbook ColorPallet, try Chip's macro:

'=========>>
Sub DisplayPallet()
Dim N As Long
For N = 1 To 56
Cells(N, 1).Interior.ColorIndex = N
Next N
End Sub
'<<=========