Using VBA to select a group of cells based on same values

Question

I would like write a VBA code to select a group of cells that has the same value and colour it.

For Row A, Staff ID, are the same, for the same person, I intend to scan through them and if they are the same, fill the cells with the light blue colour you see in the picture above, for Column A to MaxColumn of Current Region.

I have a drafted a code to do that but it does nothing when I run it. Any help will be appreciated:

Sub ActualColouring()

Dim SerialNumber As Integer

SerialNumber = 2                                                                                            'this variable will be assign to the rows, ignore the header, start from 2

Do While Cells(1, SerialNumber).Value <> ""                                                   'keep looping as long as cell is not blank
    If Cells(1, SerialNumber).Value = Cells(1, SerialNumber + 1).Value Then     'if the value of the cell is the same as the cell below, then
        Cells(1, SerialNumber).Select                                                                  'then select it
        With Selection.Interior                                                                             'this line is the start of the fill colouring
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent1
            .TintAndShade = 0.799981688894314
            .PatternTintAndShade = 0
        End With                                                                                                'end of fill colouring function
    End If
    SerialNumber = SerialNumber + 1                                                               'move to the next cell
Loop                                                                                                               'loop until the end of current region
End Sub

score 0 · Accepted Answer · edited May 23 '17 at 11:45

Qualify the objects and avoid select

Sub ActualColouring()

Dim ws as Worksheet
Set ws = ThisWorkbook.Worksheets("mySheet") ' change name as needed

With ws

    Dim SerialNumber As Long, lRow as Long
    lRow = .Range("A" & .Rows.Count).End(xlup).Row

    For SerialNumber = 2 to lRow                                                                                             

        If .Cells(1, SerialNumber).Value = .Cells(1, SerialNumber + 1).Value Then     
            With .Cells(1, SerialNumber).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent1
                .TintAndShade = 0.799981688894314
                .PatternTintAndShade = 0
            End With                                                                                                
        End If
    Next

End With

End Sub

Thanks Scott! You are a life-saver! :) – Cadell Teng Dec 08 '16 at 01:48 — Cadell Teng, Dec 08 '16 at 01:48

Using VBA to select a group of cells based on same values

1 Answers1