Macro to colour or highlight cells with the same values alternatively

[SONART]

Hi All,

Could someone please help.

I'm new to the world of VB.
Is there a macro or conditional formatting, which will allow a range of cells with the same values have an assigned colour ie. rows with Nepean values red, then followed by the following range of cells with the same values ie. rows with Liverpool values blue. The list is dynamic and changes location and store values.

E.g.
Territory Location Store
J Smith Nepean Nepean Store
J Smith Nepean Nepean Store
J Smith Liverpool Liverpool Store
J Smith Liverpool Liverpool Store
J Smith Liverpool Liverpool Store

Thanks in advance,
SONART

 

[mirabeau]

VBA?

Sub colors()
Dim lr, k As Long, q As Long, e, g
lr = Range("A" & Rows.Count).End(3).Row
For Each e In Range("A2:A" & lr).Value
    k = k + 1
    If e <> g Then q = q + 1: g = e
    Range("A" & k + 1).Interior.ColorIndex = 3 + 2 * (q Mod 2)
Next e
End Sub

 

[SONART]

Thank you so much mirabeau for taking the time to respond.

How can I also colour columns B and C (not just A)?
Is there any way I can automate this, simply by selecting the worksheet?
Is there any way it resets? The list is driven by an advanced filter so it varies in length. I noticed the colour stays.

 

[alan.m]

Hi Sonart
I hope mirabeau won't mind me jumping in,
(I was looking at the code to understand what the 3 means in Range("A" & Rows.Count).End(3).Row)
I've added a bit in the start of the macro to clear all cell colours,
and extended the range to include columns B abd C
try

Sub colors()
Dim lr, k As Long, q As Long, e, g
    'clear old formatting
    Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    'colour cells
    lr = Range("A" & Rows.Count).End(3).Row
    For Each e In Range("A2:A" & lr).Value
        k = k + 1
        If e <> g Then q = q + 1: g = e
        Range("A" & k + 1, "C" & k + 1).Interior.ColorIndex = 3 + 2 * (q Mod 2)
    Next e
End Sub

To have this run whenver you want, you might assign it to a button on your toolbar?
HTH

 

[mirabeau]

Hi Sonart
I hope mirabeau won't mind me jumping in,
(I was looking at the code to understand what the 3 means in Range("A" & Rows.Count).End(3).Row)
HTH

Go to it Alan. You're doing fine.

re End(3), if still interested you might have a look at

http://www.mrexcel.com/forum/showthread.php?t=551252

and

http://www.mrexcel.com/forum/showthread.php?t=548296 Post#7

 

[SONART]

Hi Alan,

Thanks for taking on my problem.

I used your macro and it appears to be working. I just made a couple of changes to automate the worksheet.

The actual table I'm working with start in cell B8 (first column header) and ends in cell I8 (last column header). As mentioned below, the number of rows are dynamic depending on the number of store data. How do you adjust these cell references in the macro?

This is what I have so far:

Private Sub Worksheet_Activate()
Dim lr, k As Long, q As Long, e, g
'clear old formatting
Cells.Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'colour cells
lr = Range("A" & Rows.Count).End(3).Row
For Each e In Range("B2:B" & lr).Value
k = k + 1
If e <> g Then q = q + 1: g = e
Range("A" & k + 1, "D" & k + 1).Interior.ColorIndex = 2 + 15 * (q Mod 2)
Next e

End Sub

 

[alan.m]

Hi Sonart,
mirabeau took care of that for you with part that interested me:
lr = Range("A" & Rows.Count).End(3).Row
lr represents that "Last Row".
The code actually starts at the bottom of your sheet and jumps upwards to the first non-blank cell and saves that row number as lr.
So the code
For Each e In Range("B2:B" & lr).Value
loops from cell B2 to cell B last row

Hope that clears it up a little for you.