Cell Shading Macro Depending on Text

Hi there.

I will have a spreadsheet similar to the image provided. Basically, I need the macro to go row by row down column I. If the cell in column I contains the word "Tech" I need the cells from column B to P to be shaded color1; if it contains "Update," color 2; if the cell is blank; leave the cell as is. Once the macro has done this, it will continue to the next row and to the same check.

The number of rows in the spreadsheet will change on a day-to-day basis depending on the data that's pulled, but the columns should remain the same.

So I think I have the shading part. This is what I have so far. I'm not sure if this is the most efficient way of coding it, but it kinda works. I guess another problem would be if in the future the column with this info (column I) changes and shifts.

Sub Shading()

ActiveSheet.Range("I3").Select


If Range("I3") = "Tech" Then
    Range("C3:P3").Select
    With Selection.Interior
        .ColorIndex = 36
        .Pattern = xlSolid
    End With
ElseIf Range("I3") = "Updates" Then
    Range("C3:P3").Select
    With Selection.Interior
        .ColorIndex = 34
        .Pattern = xlSolid
    End With
End If

End Sub

I've been trying to figure something out, but I haven't been able to wrap my brain on how to do this.

Thanks to all for any help you can provide.

Hi

Try this

Sub aaa()
  For Each ce In Range("I3:I" & Cells(Rows.Count, "I").End(xlUp).Row)
    Select Case ce.Value
      Case "Tech"
        colr = 36
      Case "Update"
        colr = 34
      Case Else
        colr = xlNone
    End Select
    Cells(ce.Row, "B").Resize(1, 15).Interior.ColorIndex = colr
  
  Next ce
End Sub

rylo

Hello BluTalon,

This version automatically "reads" the size of the your array using the first cell ($A$3) as a reference. It allows you to use more colors easily later on.

Sub Shading()

  Dim CI As Long
  Dim R As Long
  Dim Rng As Range
  
    Set Rng = ActiveSheet.Range("$A$3").CurrentRegion
    
      For R = 1 To Rng.Rows.Count
        Select Case Rng.Cells(R, 9)
          Case Is = "Tech"
            CI = 36
          Case Is = "Update"
            CI = 34
          Case Else
            CI = xlNone
        End Select
        With Rng
          .Range(Cells(R, 1), Cells(R, .Columns.Count)).Interior.ColorIndex = CI
        End With
      Next R
    
End Sub

Sincerely,
Leith Ross

oops. I'm sorry. Both seem to work, but I forgot that it also has a header row that automatically gets created when the spread sheet is exported.

So, the header should not be edited, but it does contain "Tech" in one of the cells. This of course kinda screws up the way the macro formats the cells as the header turns a different color. Is there a way we can have it start below the header?

Thanks and sorry again

Sub test()
Dim i As Long, myClr As Long
With Range("a1").CurrentRegion
    With .Resize(, .Columns.Count - 1).Offset(,1)
        For i = 2 To .Rows.Count
            Select Case .Rows(i).Range("h1").Value
                Case "Tech" : myClr = 36
                Case "Update" : myClr = 34
                Case Else : myClr = xlNone
            End Select
            .Rows(i).Interior.ColorIndex = myClr
        Next
    End With
End With
End Sub

Hello BluTalon,

To skip the header (1st row in the array), The "For R" loop needs to start at 2. I have made the change already. You can also change the column to check by changing the variable "C".

Sub Shading()

  Dim C As Long
  Dim CI As Long
  Dim R As Long
  Dim Rng As Range
  
    C = 9   'Column "I"

    Set Rng = ActiveSheet.Cells(StartRow, C).CurrentRegion
    
      For R = 2 To Rng.Rows.Count
        Select Case Rng.Cells(R, C)
          Case Is = "Tech"
            CI = 36
          Case Is = "Update"
            CI = 34
          Case Else
            CI = xlNone
        End Select
        With Rng
          .Range(Cells(R, 1), Cells(R, .Columns.Count)).Interior.ColorIndex = CI
        End With
      Next R
    
End Sub

Sincerely,
Leith Ross