CODEWITHSUNDEEP
arraysexcelvbaloopsrange
AlexisW
AlexisW

Reputation: 13

Loop over specified columns and rows

I would like to create a selection of columns (like an array/vector/list) and loop a macro through these columns.

This macro is designed to colour all the cells in one column based on their value.

Sub colour_cells()

    Dim rgA As Range
    Set rgA = Range("A2", Range("A2").End(xlDown))
    Dim testcellA As Range
    Dim i As Long
    Dim c As Long
    c = rgA.Cells.Count

    For i = 1 To c
        Set testcellA = rgA(i)
        Select Case testcellA
            Case Is = 0
                With testcellA
                    .Interior.Color = rgB(255, 199, 206)
                End With
        End Select
    Next i
End Sub

I want to adjust this to apply to columns A, C, F, G, N and Z.

How can I do this without setting up multiple range objects and duplicating the macro code?

Upvotes: 1

Views: 2526

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57673

You could do that by defining an array of columns that you want to color. Then use one loop to go through the columns and another loop to go through the rows in each column.

Option Explicit

Public Sub ColourSomeCells()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1") 'define the worksheet

    Dim ColourColumns As Variant
    ColourColumns = Array("A", "C", "F", "G", "N", "Z") 'columns you want to color

    Dim LastRowInColumn As Long
    Dim iRow As Long

    Dim iCol As Variant
    For Each iCol In ColourColumns 'loop throug the array of columns
        LastRowInColumn = ws.Cells(ws.Rows.Count, iCol).End(xlUp).Row 'find last used row in that column

        For iRow = 2 To LastRowInColumn 'loop through all used cells in that column
            With ws.Cells(iRow, iCol)
                Select Case .Value
                    Case 0 'make zeros red
                        .Interior.Color = RGB(255, 199, 206)

                    Case 10, 11, 12 'make values 10-12 green
                        .Interior.Color = vbGreen

                    Case Else

                End Select
            End With
        Next iRow 'next row in that column
    Next iCol 'next column
End Sub

Upvotes: 2

Related Questions