Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Fill cell values on Interiorcolor conditions
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 D2:D10 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(D2:D10) For Each Cell in rng Sum ws3(Row:"E:I") Next Cell End Sub Thank you for your help Celeste |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Fill cell values on Interiorcolor conditions
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Fill cell values on Interiorcolor conditions
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 '<<========= --- Regards. Norman "u473" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Fill a blank cell with a value using if conditions | New Users to Excel | |||
Using range to fill in cell values | Excel Programming | |||
Isolate and total cell values based on conditions | Excel Discussion (Misc queries) | |||
Auto Fill Color of a particular Cell if conditions are put | Excel Programming | |||
Cell values based upon multiple conditions | New Users to Excel |