Excel Macro to Change Color of a Row Based on Column and Cell Value

Question

I have the below code and would like it to be modified to work on all worksheets in the active workbook. Also, it currently does the entire row, but is there a way to modify it to only highlight the row until the data stops (example: AJ or AC etc. not A-~)?

Sub ChangeColor()

lRow = Range("A" & Rows.Count).End(xlUp).Row
Set MR = Range("A2:K2" & lRow)
For Each cell In MR
    If cell.Value = "CENTRL DISTRICT" Then cell.EntireRow.Interior.ColorIndex = 10
    If cell.Value = "KC DISTRICT" Then cell.EntireRow.Interior.ColorIndex = 3
    If cell.Value = "NE DISTRICT" Then cell.EntireRow.Interior.ColorIndex = 11
    If cell.Value = "SE DISTRICT" Then cell.EntireRow.Interior.ColorIndex = 30
    If cell.Value = "ST LOUIS DIST" Then cell.EntireRow.Interior.ColorIndex = 12
    If cell.Value = "SW DISTRICT" Then cell.EntireRow.Interior.ColorIndex = 13
Next

End Sub

Answer 1

You can use the below, you needed to change the range in the if statement.

You haven't given worksheet names here, but you should really fully reference all your ranges too.

Sub ChangeColor()
    lRow = Range("A" & Rows.Count).End(xlUp).Row
    Set MR = Range("A2:K2" & lRow)
    For Each cell In MR
        If cell.Value = "CENTRL DISTRICT" Then Range("A" & cell.Row & ":J" & cell.Row).Interior.ColorIndex = 10
        If cell.Value = "KC DISTRICT" Then Range("A" & cell.Row & ":J" & cell.Row).Interior.ColorIndex = 3
        If cell.Value = "NE DISTRICT" Then Range("A" & cell.Row & ":J" & cell.Row).Interior.ColorIndex = 11
        If cell.Value = "SE DISTRICT" Then Range("A" & cell.Row & ":J" & cell.Row).Interior.ColorIndex = 30
        If cell.Value = "ST LOUIS DIST" Then Range("A" & cell.Row & ":J" & cell.Row).Interior.ColorIndex = 12
        If cell.Value = "SW DISTRICT" Then Range("A" & cell.Row & ":J" & cell.Row).Interior.ColorIndex = 13
    Next
End Sub

Answer 2

Try this (note I have added declarations to your code).

Sub ChangeColor()

Dim lRow As Long, MR As Range, cell As Range, ws As Worksheet, lCol As Long
Dim wf As WorksheetFunction

Set wf = WorksheetFunction

For Each ws In Worksheets
    lRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    lCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
    Set MR = ws.Range("A2").Resize(lRow - 1, lCol)
    For Each cell In MR
        If cell.Value = "CENTRL DISTRICT" Then ws.Cells(cell.Row, 1).Resize(, lCol).Interior.ColorIndex = 10
        If cell.Value = "KC DISTRICT" Then ws.Cells(cell.Row, 1).Resize(, lCol).Interior.ColorIndex = 3
        If cell.Value = "NE DISTRICT" Then ws.Cells(cell.Row, 1).Resize(, lCol).Interior.ColorIndex = 11
        If cell.Value = "SE DISTRICT" Then ws.Cells(cell.Row, 1).Resize(, lCol).Interior.ColorIndex = 30
        If cell.Value = "ST LOUIS DIST" Then ws.Cells(cell.Row, 1).Resize(, lCol).Interior.ColorIndex = 12
        If cell.Value = "SW DISTRICT" Then ws.Cells(cell.Row, 1).Resize(, lCol).Interior.ColorIndex = 13
    Next cell
Next ws

End Sub

Answer 3

This is simular to some of the above ... difference is it will hi-lite from the beginning to the last used column. It also cycles through all the sheets in the activeworkbook. It assumes the District Name is in column A.

Sub ChangeColor()

    For x = 1 To ActiveWorkbook.Sheets.Count

    Sheets(x).Select

    lRow = ActiveSheet.UsedRange.SpecialCells(xlLastCell).Row
    lCol = ActiveSheet.UsedRange.SpecialCells(xlLastCell).Column
    Set MR = Range("A2:A" & lRow)

      For Each cell In MR
        If cell.Value = "CENTRL DISTRICT" Then Range(Cells(cell.Row, 1), Cells(cell.Row, lCol)).Interior.ColorIndex = 10
        If cell.Value = "KC DISTRICT" Then Range(Cells(cell.Row, 1), Cells(cell.Row, lCol)).Interior.ColorIndex = 3
        If cell.Value = "NE DISTRICT" Then Range(Cells(cell.Row, 1), Cells(cell.Row, lCol)).Interior.ColorIndex = 11
        If cell.Value = "SE DISTRICT" Then Range(Cells(cell.Row, 1), Cells(cell.Row, lCol)).Interior.ColorIndex = 30
        If cell.Value = "ST LOUIS DIST" Then Range(Cells(cell.Row, 1), Cells(cell.Row, lCol)).Interior.ColorIndex = 12
        If cell.Value = "SW DISTRICT" Then Range(Cells(cell.Row, 1), Cells(cell.Row, lCol)).Interior.ColorIndex = 13
      Next

    Next x

End Sub

Answer 4

The code below will loop through all sheets in ActiveWorkbook (even though I feel strongly against using ActiveWorkbook ), and per each sheet loop through MR range.

I've replaced your multiple Ifs with Select Case .

Code

Option Explicit

Sub ChangeColor()

Dim lRow As Long, lCol As Long
Dim MR As Range, Cell As Range
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Sheets
    With ws
        lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set MR = .Range("A2:K2" & lRow)
        For Each Cell In MR
            lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column ' <-- in case the last column is different per row
            Select Case Cell.Value
                Case "CENTRL DISTRICT"
                    Cell.Resize(1, lCol - Cell.Column + 1).Interior.ColorIndex = 10
                Case "KC DISTRICT"
                    Cell.Resize(1, lCol - Cell.Column + 1).Interior.ColorIndex = 3
                Case "NE DISTRICT"
                    Cell.Resize(1, lCol - Cell.Column + 1).Interior.ColorIndex = 11
                Case "SE DISTRICT"
                    Cell.Resize(1, lCol - Cell.Column + 1).Interior.ColorIndex = 30
                Case "ST LOUIS DIST"
                    Cell.Resize(1, lCol - Cell.Column + 1).Interior.ColorIndex = 12
                Case "SW DISTRICT"
                    Cell.Resize(1, lCol - Cell.Column + 1).Interior.ColorIndex = 13
            End Select
        Next Cell
    End With
Next ws

End Sub

Answer 5

This should work for you. You can set a begin and end point to your liking just by changing the letters, which is a reference to the column letters. Range("A" & n, "G" & n) This is a simpler way to get what you want.

Hope I helped.

    Sub ChangeColor()
    Dim nlast As Long

    Sheets("sheetname").Activate
    Set sht = ActiveWorkbook.ActiveSheet
        nlast = Cells(Rows.Count, "A").End(xlUp).Row

                For n = nlast To 1 Step -1
                 If sht.Cells(n, "A").Value = "CENTRL DISTRICT" Then sht.Range("A" & n, "G" & n).Interior.ColorIndex = 10
                 If sht.Cells(n, "A").Value = "KC DISTRICT" Then sht.Range("A" & n, "G" & n).Interior.ColorIndex = 3
                 If sht.Cells(n, "A").Value = "NE DISTRICT" Then sht.Range("A" & n, "G" & n).Interior.ColorIndex = 11
                 If sht.Cells(n, "A").Value = "SE DISTRICT" Then sht.Range("A" & n, "G" & n).Interior.ColorIndex = 30
                 If sht.Cells(n, "A").Value = "ST DISTRICT" Then sht.Range("A" & n, "G" & n).Interior.ColorIndex = 12
                 If sht.Cells(n, "A").Value = "SW DISTRICT" Then sht.Range("A" & n, "G" & n).Interior.ColorIndex = 13
            Next n
     End Sub

Answer 6

i have made a similar thing to color rows in a table in Excel. this below algo is not much efficient but can make significant changes for it's optimization.

This will do your task.

Private Sub CommandButton21_Click()
Dim i As Integer
i = 2
Dim previousText As String
Dim interiorColorIndex As Integer
Dim fontColorIndex As Integer
interiorColorIndex = 48
fontColorIndex = 2

Do While Cells(i, 3).Value <> ""
    Dim newText As String
    text = Cells(i, 3).Value
    text = Mid(text, 1, 7)

    If previousText = "" Then previousText = text

    If text = previousText Then
        For j = 1 To 10
            Cells(i, j).Interior.ColorIndex = interiorColorIndex
            Cells(i, j).Font.ColorIndex = fontColorIndex
        Next j
    Else
        previousText = text
        If interiorColorIndex = 25 Then
            interiorColorIndex = 48
        Else
            interiorColorIndex = 25
        End If
        For j = 1 To 10
            Cells(i, j).Interior.ColorIndex = interiorColorIndex
            Cells(i, j).Font.ColorIndex = fontColorIndex
        Next j
    End If

    i = i + 1
Loop

End Sub