mercredi 24 mai 2017

Compare ells A3 and A2, if equal, nothing else color row 3 cells A though F. Repeat with next row

What I have are a list of contracts below a header row. Some contracts take up multiple rows.

What I would like is to have a VBA Macro that will compare cell A3 to A2. If they are the same; next. If they are different, then select the cells A3:F3 and change Interior.Color to grey.

Then compare A4 to A3, then A5 to A4 and repeat for all used cells in the A column, effectively making a table.

This is what the screen looks like:

Row Column A Column B C D E F

  1. 000000 (Info) (Info) (Info) (Info) (Info)
  2. 111111 (Info) (Info) (Info) (Info) (Info)
  3. 123456 (Info) (Info) (Info) (Info) (Info)
  4. 123456 (Info) (Info) (Info) (Info) (Info)
  5. 654321 (Info) (Info) (Info) (Info) (Info)
  6. 124536 (Info) (Info) (Info) (Info) (Info)
  7. 666666 (Info) (Info) (Info) (Info) (Info)

What I would like to see is:

  1. 000000 (Info) (Info) (Info) (Info) (Info) 'line is clear
  2. 111111 (Info) (Info) (Info) (Info) (Info) 'line is grey
  3. 123456 (Info) (Info) (Info) (Info) (Info) 'line is clear
  4. 123456 (Info) (Info) (Info) (Info) (Info) 'line is clear
  5. 654321 (Info) (Info) (Info) (Info) (Info) 'line is grey
  6. 124536 (Info) (Info) (Info) (Info) (Info) 'line is clear
  7. 666666 (Info) (Info) (Info) (Info) (Info) 'line is grey

I have spent my day searching and have found (and worked on the following script however it is only coloring the first cell in the line.

Sub Line_Shading()

Application.ScreenUpdating = False
Dim this As Variant
Dim previous As Variant
Dim currentColor As Long

Dim rng As Range 
Dim a As Range   
' pick a color to start with
currentColor = 14277081              ' 14277081 Grey or 16777215 Clear
' rng = used and visible cells

Set rng = Range("A2:A" & Range("A2").End(xlDown).Row)

For Each a In rng
    If Not a.Row = 1 Then            ' skip header row
        this = a.Value
        'some simple test logic to switch colors
        If this <> previous Then
            If currentColor = 14277081 Then
                currentColor = 16777215
            ElseIf currentColor = 16777215 Then
                currentColor = 14277081
            End If
        End If

        'set interior color
        a.Interior.color = currentColor 'Interior.Color

        previous = this

   End If
Next a
Application.ScreenUpdating = True

End Sub

I feel that it will just be a modification of the line: a.Interior.color = currentColor 'Interior.Color but I just can't see the solution.

Suggestions?

Aucun commentaire:

Enregistrer un commentaire