I have following formatting requirements - not sure if I can use conditional formatting (don't think so) so might be a worksheet_change event?
If NET =< 10,000 and GROSS =<100,000 highlight AE only
If NET =< 100,000 and GROSS =<1,000,000 highlight AE & AW
If NET =< 1,000,000 and GROSS =<25,000,000 highlight AW & HC
If NET =< 5,000,000 and GROSS =<100,000,000 highlight AW & HC & SH
If NET =< 30,000,000 and GROSS >100,000,000 highlight AW & HC & SH & CT
If NET > 30,000,000 Exec only (doesn't matter about gross)
The idea being as the numbers in each column are entered the adjacent cells would highlight according to the criteria listed.
Its a little complicated for my level and was hoping someone would help
Her's an outline. It doesn't meet all your criteria, but is maybe a way forward
[VBA]Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
Case 1
Select Case Target.Value
Case Is > 30000000
Target.Offset(, 7).Interior.ColorIndex = 8
Case Is >= 1000000
Target.Offset(, 3).Interior.ColorIndex = 8
Case Is >= 1000
Target.Offset(, 2).Interior.ColorIndex = 8
End Select
Case 2
Select Case Target.Value
Case Is > 100000000
Infill Target, 5
Case Is <= 100000000
Infill Target, 4
Case Is >= 25000000
Infill Target, 3
Case Is >= 1000000
Infill Target, 2
End Select
End Select
End Sub
Private Sub Infill(Target As Range, x As Long)
Target.Offset(, x).Interior.ColorIndex = 8
For i = x - 1 To 0 Step -1
With Target.Offset(, i)
If .Interior.ColorIndex = xlNone Then
.Interior.ColorIndex = 8
Else
Exit Sub
End If
End With
Next
End Sub[/VBA]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
I understand some of it but again would be grateful for some commentary as to what (especially the 2nd sub) is doing and any clue as to how it can be further developed.
Assume case 1 is column A & case 2 column B
In case 2 are you assigning a number (based on cell value in B) to 'infill'?
Case 2 uses the value to colour the rightmost cell. The Offset value diminishes, colouring each cell in turn until a coloured cell is reached. Step though the code using the F8 key to see how this happens.
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
It should handle cases if other than Col A or Col B is changed (just exits) and if you should paste or fill more that one row's worth of data.
As personal style, I like to define Const's to hold those kind of numbers, and to try to translate your business rules ( If ... and ... Then ...) into code. There didn't seem to be any performance issues, so I figured that it was OK
[VBA]
Option Explicit
Const cNET As Long = 1
Const cGROSS As Long = 2
Const cAE As Long = 3
Const cAW As Long = 4
Const cHC As Long = 5
Const cSH As Long = 6
Const cCT As Long = 7
Const cEXEC As Long = 8
Const c10K As Double = 10000#
Const c100K As Double = 100000#
Const c1M As Double = 1000000#
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rRow As Range, rFirst2Cols As Range
Set rFirst2Cols = Range(Me.Columns(1), Me.Columns(2))
If Intersect(Target, rFirst2Cols) Is Nothing Then Exit Sub
For Each rRow In Intersect(Target, rFirst2Cols).Rows
With rRow.EntireRow
.Cells(1, cAE).Resize(1, 6).Interior.ColorIndex = xlColorIndexAutomatic
If .Cells(1, cNET).Value <= c10K And .Cells(1, cGROSS).Value <= c100K Then
.Cells(1, cAE).Interior.ColorIndex = 8
ElseIf .Cells(1, cNET).Value <= c100K And .Cells(1, cGROSS).Value <= c1M Then
.Cells(1, cAE).Interior.ColorIndex = 8
.Cells(1, cAW).Interior.ColorIndex = 8
ElseIf .Cells(1, cNET).Value <= c1M And .Cells(1, cGROSS).Value <= 25 * c1M Then
.Cells(1, cAE).Interior.ColorIndex = 8
.Cells(1, cAW).Interior.ColorIndex = 8
ElseIf .Cells(1, cNET).Value <= 5 * c1M And .Cells(1, cGROSS).Value <= 100 * c1M Then
.Cells(1, cAW).Interior.ColorIndex = 8
.Cells(1, cHC).Interior.ColorIndex = 8
.Cells(1, cSH).Interior.ColorIndex = 8
ElseIf .Cells(1, cNET).Value <= 30 * c1M And .Cells(1, cGROSS).Value > 100 * c1M Then
.Cells(1, cAW).Interior.ColorIndex = 8
.Cells(1, cHC).Interior.ColorIndex = 8
.Cells(1, cSH).Interior.ColorIndex = 8
.Cells(1, cCT).Interior.ColorIndex = 8
ElseIf .Cells(1, cNET).Value > 30 * c1M Then
.Cells(1, cEXEC).Interior.ColorIndex = 8
End If
End With
Next
I seem to understand Pauls code a little better and having made a couple of small changes it does what I need it to do.
I just have one other requirement - some of the numbers entered will be negative but it doesn't matter as far as the criteria goes e.g. +or-10,000 NET, +or- 100,000 GROSS gives same result. Using negative numbers seems to upset things - is there any way to fix ( I thought maybe a hidden column that had the input converted and use these columns for the code - but don't know how to achieve this)
Reply With Quote
