Solved: Formatting help

[blackie42]

Hi,

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

thanks
Jon

[mdmackillop]

Her's an outline. It doesn't meet all your criteria, but is maybe a way forward
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

[blackie42]

Thanks very much for your work.

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'?

regards
Jon

[mdmackillop]

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.

[Paul_Hossler]

Another approach

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




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

End Sub


Paul

[blackie42]

Thanks for your help guys.

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)


regards
Jon

[mdmackillop]

Use ABS to ignore the negative values

[blackie42]

Hi,

Where would ABS fit in to these lines of code?

thanks

[mdmackillop]

If ABS(.Cells(1, cNET).Value) <= etc.

[blackie42]

Ok thanks again for the help from you guys

regards
Jon

[mckeown55]

that was very helpful to me as well

[blackie42]

Hi,

Can you tell me what this bit of code is doing please

.Cells(1, cAE).Resize(1, 6).Interior.ColorIndex = xlColorIndexAutomatic



thanks
jon

[Paul_Hossler]

cAE is a Const = 3

So starting from a range = the single Cell (1,3), resize that Range to 1 row and 6 cols, and change the interior fill to Automatic

Paul