Colour row if cell value is met

[sharky12345]

I'm struggling with this and can't seem to find anything that does what I need. I want to achieve this by VBA and not conditional formatting - If the value of the cell in range E9:E6999 is 'Team' or 'Campaign' then I want THAT ROW from A:R only to be filled yellow, and no fill if not. I can't seem to find anything that does only that range, I've found plenty that fill the entire row but that's not what I want. I need this to run ideally on a command button within a userform but that's not essential if it can't be done.

 

[Andrew Poulsom]

Try:

Sub Test()
    Dim Cell As Range
    For Each Cell In ActiveSheet.Range("E9:E6999")
        If Cell.Value = "Team" Or Cell.Value = "Campaign" Then
            With Cell.EntireRow.Resize(, 18).Interior
                .ColorIndex = 6
                .Pattern = xlSolid
            End With
        Else
            With Cell.EntireRow.Resize(, 18).Interior
                .ColorIndex = xlNone
                .Pattern = xlSolid
            End With
        End If
    Next Cell
End Sub

 

[sharky12345]

Andrew,

Thanks - that does work but it fills the rest of the sheet white when I need it with no fill.

Have I missed something?

 

[Andrew Poulsom]

Sorry:

Sub Test()
    Dim Cell As Range
    For Each Cell In ActiveSheet.Range("E9:E6999")
        If Cell.Value = "Team" Or Cell.Value = "Campaign" Then
            With Cell.EntireRow.Resize(, 18).Interior
                .ColorIndex = 6
                .Pattern = xlSolid
            End With
        Else
            With Cell.EntireRow.Resize(, 18).Interior
                .ColorIndex = xlNone
            End With
        End If
    Next Cell
End Sub

 

[sharky12345]

No problem - that's perfect, many thanks!

 

[sharky12345]

Can this be adapted slightly to include a border around the relevant cells? (and then removed if the criteria is not met).

 

[Andrew Poulsom]

Did you try it?

 

[sharky12345]

Yes - I tried the following;

.Borders(xlEdgeLeft).LineStyle = xlContinuous 
    .Borders(xlEdgeRight).LineStyle = xlContinuous 
    .Borders(xlEdgeBottom).LineStyle = xlContinuous 
    .Borders(xlEdgeTop).LineStyle = xlContinuous

and I got Runtime error 438 'Object doesn't support this property or method'.

 

[Andrew Poulsom]

Please post the entire code. The Interior object doesn't have a Borders property.

 

[sharky12345]

Here you go Andrew;

Sub Fill()
    Dim Cell As Range
    For Each Cell In ActiveSheet.Range("E9:E6999")
        If Cell.Value = "Team" Or Cell.Value = "Campaign" Then
            With Cell.EntireRow.Resize(, 18).Interior
                .ColorIndex = 6
                .Pattern = xlSolid
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                
            End With
              
        Else
            With Cell.EntireRow.Resize(, 18).Interior
                .ColorIndex = xlNone
                
            End With
        End If
    Next Cell
End Sub