I don't think I'm doing thsi right. VBA to colour rows

[ClimoC]

Hey everybody

I have a large schedule where each row is sorted by the First date (already doing/done) but as there is a lot of data, we want to be able to colour the cell rows for each sequential date on the schedule.

So the first row starts at 6, the column with the date in question is "G", and we only want columns G:L coloured when the macro runs.

The idea is that the first (eg, 10) rows that have the date 28/08/09 will be coloured one way, and then the next 4 rows which are 29/08/09 will be another colour, next 15 that are 30/08/09 will be the first colour again (only wanting to work with two colours) - but only colouring the columns G:L in those particular rows.

I am working in Excel 2003.

I tried making this, but I don't think it's doing anything right, other than colouring the entire first row fuscia (so I can't even get the 'only colour columns G:L' bit right)

Please help

Cheers

Sub colourdaterows()

Application.ScreenUpdating = False
     
Dim firstdate As Range, Cel As Object
Dim ary As Range
    Set ary = Range("Schedule!G6:L500")
    Set firstdate = Range("Schedule!G6")
     
    For Each Cell In ary
        
        If Cell.Value = firstdate Then
        ActiveCell.EntireRow.Select
           With Selection.Columns("G:L").Interior.ColorIndex = 24
           End With
        ElseIf Cell.Value = ActiveCell.Column + 1 Then
        ActiveCell.EntireRow.Select
            With Selection.Columns("G:L").Interior.ColorIndex = 0
            End With
        End If
    Next
    
Application.ScreenUpdating = True
End Sub

 

[dave3009]

Hi

Have you used up all your conditional formats? You can use it to do your banding without the need to fire a macro.

Condition 1:Formula Is: =MOD($A1, 2)=1 set desired format.
Condition 2:Formula Is: =MOD($A1, 2)=0 set desired format.

This bands the dates based on whether they are odd or even assuming the date is held in column A, you'd highlight columns G-L and apply these formats. The only limitation here is if you have two even dates next to each other. I'll revisit your macro to see if I can't get it to work for you

 

[ClimoC]

Well that does work thanks - and the nature of the business there would never be a day missed

But Can this be put in a macro? I tried recording it but it still did conditional formatting. I'd like to avoid CF if possible.

Ta
C

 

[MickG]

Hi, You could try this , it seems to work !!

[COLOR="Navy"]Sub[/COLOR] MG02Sep24
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("g6"), Range("g" & Rows.Count).End(xlUp))
col = 34
Rng(1).Resize(, 5).Interior.ColorIndex = col
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Dn.Offset(1) <> Dn [COLOR="Navy"]Then[/COLOR]
            col = IIf(Dn.Interior.ColorIndex = 34, 35, 34)
            Dn.Offset(1).Resize(, 5).Interior.ColorIndex = col
        [COLOR="Navy"]Else[/COLOR]
            Dn.Offset(1).Resize(, 5).Interior.ColorIndex = col
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[ClimoC]

Wow mick! That works a treat! I had got it working by just using MOD in CF, but was trying to avoid that as everytime I use CF to do something in the table, it adds 400kb to the size and if possible I'd like to keep this whole thing under 1mb (currently up around 720kb atm)

I'm just going to try and sneak some light-grey grid-lines in so it stays easy to read.

If it fails monumentally I'll come back - but thanks all the same.

 

[ClimoC]

Yeah - Can someone help? MickG?

I can't draw the gridlines. I got it drawing borders around the entire range (Col G to Col L) but I need it to 'drawgrid', no borders (so each cell has a border.

I would need it to work into Mick's formula as above. It should also be taken into consideration that I've set this now as a WATCHRANGE macro, as below.

Private Sub Worksheet_Selectionchange(ByVal Target As Range)
If Target.Column = 7 Then
Dim Rng As Range, Dn As Range, col As Integer
Set Rng = Range(Range("g6"), Range("g" & Rows.Count).End(xlUp))
col = 34
Rng(1).Resize(, 6).Interior.ColorIndex = col
    For Each Dn In Rng
        If Dn.Offset(1) <> Dn Then
            col = IIf(Dn.Interior.ColorIndex = 34, 0, 34)
            Dn.Offset(1).Resize(, 6).Interior.ColorIndex = col
                     
           
        Else
            Dn.Offset(1).Resize(, 6).Interior.ColorIndex = col
            
        End If
    Next
End If
End Sub