More than 3 formatting conditions - select case?

[HelenW]

Hello again!

My next problem - I have 5 formatting conditions that I need to add in my macro and have just recently found out that I can't have more than 3 in my version of Excel - DOH.

Anyway, some research has indicated that you can use something called select case to get round this? Hopefully someone can help please!

I need to colour the range as follows:

Range("H2:M2").Select
    Range(Selection, Selection.End(xlDown)).Select

When P2= 1, 2, 3 or 5 then different colours will apply (1 per number) to the above range. If P2=4 then the following range needs to be used:

Range("H2:I2,L2:M2").Select
    Range(Selection, Selection.End(xlDown)).Select

And a different colour is used.

Is that enough info for someone to provide me with the correct code please?

Thanks!

Helen

[royUK]

Try this, change the condition ("A","B" etc) to suit

Option Explicit

'START OF CODE


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim intColour As Integer

    If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
        Select Case Target
            Case "A": intColour = 6
            Case "B": intColour = 3
            Case "C": intColour = 7
            Case "D": intColour = 18
            Case "E": intColour = 15
            Case "F": intColour = 42
            Case Else:    'do nothing
        End Select
        Target.Interior.ColorIndex = intColour
    End If
End Sub

To add this code to your worksheet, do the following:

Copy the code that you want to use
Select the worksheet in which you the code to run
Right click on the sheet tab and choose View Code, to open the Visual Basic Editor.
Where the cursor is flashing, choose Edit | Paste

[royUK]

This code should work for you

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim intColour As Integer

Set rng = ActiveSheet.Range(Cells(2, 8), Cells(Rows.Count, 13).End(xlUp))
    
    If Not Intersect(Target, rng) Is Nothing Then
        Select Case Range("P2").Value
            Case 1: intColour = 6
            Case 2: intColour = 3
            Case 3: intColour = 7
            Case 4: intColour = 18
            Case 5: intColour = 15
            Case 6: intColour = 42
            Case Else:    'do nothing
        End Select
        Target.Interior.ColorIndex = intColour
    End If
End Sub

[HelenW]

Have pasted in as suggested above but it won't run - it opens a "open macro" style box and wants me to pick one to run! So sorry to be a pain.

[royUK]

I think this code matches the ranges you are using

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim intColour As Integer

Set rng = ActiveSheet.Range(Cells(2, 8), Cells(Rows.Count, 13).End(xlUp))
    
    If Target.Address = "$P$2" Then
        Select Case Target.Value
            Case 1: intColour = 6
            Case 2: intColour = 3
            Case 3: intColour = 7
            Case 4: intColour = 18
            Case 5: intColour = 15
            Case 6: intColour = 42
            Case Else:    'do nothing
        End Select
        rng.Interior.ColorIndex = intColour
    End If
End Sub

[royUK]

Are you sure the code is in the correct place. Attach your workbook & I will check

[HelenW]

Hi Roy

Have attached the workbook - hope it makes sense.

[royUK]

It looks to me that you want to check not P2 but the cell in column P of the selected cell

[HelenW]

Yes, that's right, but it worked fine when I only had 3 conditions to use, and used conditional formatting in the vb code - it kept P as absolute, then used the relevant cell next to each row to colour the range appropriately.

[royUK]

Column P values are the results of formlas and will not trigger the change event

[HelenW]

OK, so if I do paste special and just get the values, will that work?

[Shijesh Kumar]

Try the below link.. may be of help to you

http://www.excelforum.com/excel-gene...-than-3-a.html

[royUK]

If you manually enter the value in P then this code works fine

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim intColour As Integer
    
    If Target.Column = 16 And Target.Count = 1 Then
        Select Case Cells(Target.Row, 16).Value
            Case 1: intColour = 3
            Case 2: intColour = 8
            Case 3: intColour = 4
            Case 5: intColour = 46
            Case Else:    'do nothing
        End Select
    End If
    Set rng = ActiveSheet.Range(Cells(Target.Row, 8), Cells(Target.Row, 13))
      rng.Interior.ColorIndex = intColour
End Sub

[HelenW]

I still can't get it to run! No idea what I'm doing wrong...

[royUK]

I still can't get it to run! No idea what I'm doing wrong...

Have a look at this

[HelenW]

Thanks - but not sure what is different! I *know* I am being stupid about this all, but I am a real beginner, and what I do is self-taught, so it's slow going! Is it the code on the data sheet? I bet you wish I hadn't asked about this now! I can't get it to do anything, anyway, so perhaps I should just give up...

[royUK]

Thanks - but not sure what is different! I *know* I am being stupid about this all, but I am a real beginner, and what I do is self-taught, so it's slow going! Is it the code on the data sheet? I bet you wish I hadn't asked about this now! I can't get it to do anything, anyway, so perhaps I should just give up...

If this refers to my last example, then that version updates the coloured cells each time the sheet calculates, avoiding the need for running the macro. You could also make it update on opening the workbook.

[HelenW]

Thank you for the help Roy but I am really struggling to understand how your example works. I think my main trouble, aside from not know a huge amount of vb code, is *where* to put the code within each workbook to make it do what I want! I didn't see that you'd attached another file, so will go and have a look at that now.

[HelenW]

Thanks Shijesh - I have tried the code below but when I run the macro (with cell on top cell of data in column P) it colors the first range of cells in the first row, but then jumps to the end of the data (in column P) and stops. Should it continue down to the next cell in column P, then do the formatting on the next range in that row?

Sub xformat()

    Do While ActiveCell.Value <> ""
        If ActiveCell.Value = "1" Then
              Range("$H2:$M2").Interior.ColorIndex = 3
        ElseIf ActiveCell.Value = "2" Then
              Range("$H2:$M2").Interior.ColorIndex = 8
        ElseIf ActiveCell.Value = "3" Then
              Range("$H2:$M2").Interior.ColorIndex = 4
        ElseIf ActiveCell.Value = "5" Then
              Range("$H2:$M2").Interior.ColorIndex = 46
        Else

        ActiveCell.Interior.ColorIndex = xlNone
        End If
        ActiveCell.Offset(1, 0).Activate
     Loop
     
End Sub

[Shijesh Kumar]

Sub xformat()

    Do While ActiveCell.Value <> ""
        
        If ActiveCell.Value = 1 Then
               
                Range(Cells(ActiveCell.Row, 8), Cells(ActiveCell.Row, 13)).Interior.ColorIndex = 3
        ElseIf ActiveCell.Value = 2 Then
              Range(Cells(ActiveCell.Row, 8), Cells(ActiveCell.Row, 13)).Interior.ColorIndex = 8
        ElseIf ActiveCell.Value = 3 Then
              Range(Cells(ActiveCell.Row, 8), Cells(ActiveCell.Row, 13)).Interior.ColorIndex = 4
        ElseIf ActiveCell.Value = 5 Then
              Range(Cells(ActiveCell.Row, 8), Cells(ActiveCell.Row, 13)).Interior.ColorIndex = 46
        Else
           ActiveCell.Interior.ColorIndex = xlNone
        End If
        ActiveCell.Offset(1, 0).Activate
     Loop
     
End Sub

[Shijesh Kumar]

try this

Place the cursor on the first cell containing data in column P and run macros

Sub xformat()

    Do While ActiveCell.Value <> ""
        
        If ActiveCell.Value = 1 Then
               
                Range(Cells(ActiveCell.Row, 8), Cells(ActiveCell.Row, 13)).Interior.ColorIndex = 3
        ElseIf ActiveCell.Value = 2 Then
              Range(Cells(ActiveCell.Row, 8), Cells(ActiveCell.Row, 13)).Interior.ColorIndex = 8
        ElseIf ActiveCell.Value = 3 Then
              Range(Cells(ActiveCell.Row, 8), Cells(ActiveCell.Row, 13)).Interior.ColorIndex = 4
        ElseIf ActiveCell.Value = 5 Then
              Range(Cells(ActiveCell.Row, 8), Cells(ActiveCell.Row, 13)).Interior.ColorIndex = 46
        Else
           ActiveCell.Interior.ColorIndex = xlNone
        End If
        ActiveCell.Offset(1, 0).Activate
     Loop
     
End Sub

[HelenW]

Shijesh - that is perfect! OK, I have 1 last thing I need to do that you might be able to help with. I need to colour ONLY cells H2, I2, L2, and M2 for my last condition - can you tell me how to add that in please?

[royUK]

I think this is close to what you want

[Shijesh Kumar]

Hi Helen,

I modified the code to color only H2 , I2 , L2 and M2... for last condition...

Sub xformat()

    Do While ActiveCell.Value <> ""
        
        If ActiveCell.Value = 1 Then
               
                Range(Cells(ActiveCell.Row, 8), Cells(ActiveCell.Row, 13)).Interior.ColorIndex = 3
        ElseIf ActiveCell.Value = 2 Then
              Range(Cells(ActiveCell.Row, 8), Cells(ActiveCell.Row, 13)).Interior.ColorIndex = 8
        ElseIf ActiveCell.Value = 3 Then
              Range(Cells(ActiveCell.Row, 8), Cells(ActiveCell.Row, 13)).Interior.ColorIndex = 4
        ElseIf ActiveCell.Value = 5 Then
              Range(Cells(ActiveCell.Row, 8), Cells(ActiveCell.Row, 9)).Interior.ColorIndex = 46
              Range(Cells(ActiveCell.Row, 12), Cells(ActiveCell.Row, 13)).Interior.ColorIndex = 46
        Else
           ActiveCell.Interior.ColorIndex = xlNone
        End If
        ActiveCell.Offset(1, 0).Activate
     Loop
     
End Sub

To run the code u can place the cursor anywhere in column P and run the macros...
It will format anything from that row to down (end)

[HelenW]

Brilliant - thank you so much! I tried to place a button on a different sheet to which I could assign the macro (other people will be using the sheet and I need it to be as simple as possible) but it won't work - is there a way of placing a button on a different sheet to the one in which the macro is designed to run?

Thanks again for your help.

[Shijesh Kumar]

I tried to place a button on a different sheet to which I could assign the macro (other people will be using the sheet and I need it to be as simple as possible) but it won't work - is there a way of placing a button on a different sheet to the one in which the macro is designed to run?

For that u need to add a small code... and assing it to macros

sub xrun()
sheet1.activate
range("P2").select
call xformat
end sub

Further , it would be much better to do the way.. Roy told.. it add this code..

Private Sub Worksheet_Calculate()
    Range("P2").Activate
    Call xformat
End Sub

[royUK]

You can call the addFormat macro from a button. Just add a button from the Forms ToolBar and assign the macro when prompted

[HelenW]

I think I'm there - thank you to both of you SO MUCH for all your help. I ended up using Shijesh's code, but only as I could understand how to make it work straightaway - so we will have to put up with a couple of extra button clicks until I can understand more what Roy was telling me to do!

Think I will add this thread to my favourites so I can study the examples in more detail later!

Thank you again - gratefully appreciated.

[royUK]

I've added a button & some notes to the code

[HelenW]

Hello all

I'm working with my code again, and I have got the below in place:

Sub addRows()
    Dim Rw     As Long
    Dim LastRw As Long
    LastRw = ActiveSheet.UsedRange.Rows.Count
   ' loop through column F
    For Rw = LastRw To 2 Step -1
    'ignore empty cells
        If Not IsEmpty(Cells(Rw - 1, 6)) Then
        'if the cells don't match add a row
            If Cells(Rw, 6).Value <> Cells(Rw - 1, 6).Value Then
                Cells(Rw, 6).EntireRow.Insert Shift:=xlDown
            End If
        End If
    Next Rw
End Sub

This adds a row every time there is a change in name in column F. For some reason though, it doesn't recognise the difference between "Southern" and "Strategic and Corporate" - can any one advise why?

Also, once I can get that bit sorted, I would like to apply specific formatting to the blank rows that are added (each one has a different colour that spans across the data) and the name from the Area column that corresponds to that section needs to be added into the coloured row (also with some formatting e.g. bold). Finally, I would want to delete the Area column once everything is done.

I've attached the spreadsheet I am working with, with some data that I've been using, to show what the macro does up until the point when the blank rows are entered.

I've also attached a spreadsheet that shows what the data needs to look like once everything is done!

[shg]

For some reason though, it doesn't recognise the difference between "Southern" and "Strategic and Corporate"

Your workbook contains no such examples.

[HelenW]

Oh, I attached 2 spreadsheets - the 2nd one hasn't attached. I know it doesn't say Strategic and Corporate in the above attached spreadsheet but it's the latest data that I have to work with and it doesn't include any incidences of S&C! The words are in the Area column and it definitely doesn't recognise the difference.

Not sure if my "finished" formatted spreadsheet has attached this time.