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
- 000000 (Info) (Info) (Info) (Info) (Info)
- 111111 (Info) (Info) (Info) (Info) (Info)
- 123456 (Info) (Info) (Info) (Info) (Info)
- 123456 (Info) (Info) (Info) (Info) (Info)
- 654321 (Info) (Info) (Info) (Info) (Info)
- 124536 (Info) (Info) (Info) (Info) (Info)
- 666666 (Info) (Info) (Info) (Info) (Info)
What I would like to see is:
- 000000 (Info) (Info) (Info) (Info) (Info) 'line is clear
- 111111 (Info) (Info) (Info) (Info) (Info) 'line is grey
- 123456 (Info) (Info) (Info) (Info) (Info) 'line is clear
- 123456 (Info) (Info) (Info) (Info) (Info) 'line is clear
- 654321 (Info) (Info) (Info) (Info) (Info) 'line is grey
- 124536 (Info) (Info) (Info) (Info) (Info) 'line is clear
- 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