Color alternate Entire row dependant on value in "A"

L

Les

Hi, i have document numbers in column "A", all like numbers must be the
same color e.g.

rows 1, 2, 3, 4 white then 5 grey, 6 white, 7 & 8 grey etc..

I would like to do this with code as the length of data is variable and
automatically created..


1.A03697 1712 7531581 ASSY HSE BTW RADIATOR RETURN & THERM/HSG
2.A03697 1362 1433077 TEMPERATURE SENSOR WATER, CLIPSE ATTACHM
3.A03697 6111 6938076 MDL TEMP SENSOR E9X N46+NG6/N52
4.A03697 1713 7543026 AY COOLANT EXPANSION TANK L2 SP-IG.ENGIN
5.A04933 3610 6775592 STEEL WHEEL 7JX16 EH2 IS34 STYL 12)
6.A07050 5175 7128503 SEAL RADIATOR
7.A07110 2120 9901023 PAN SCREW M8X16-8.8-ZNS
8.A07110 2151 1203012 KNURLED-HEAD BOLT
A07346 5121 7059891 LU UNIFORM LOCK SYSTEM LHD
A07346 6612 6937508 ADAPTER PURSE KEY PL2
A07346 5116 7075474 ASSY GLOVE BOX CPL A COL
A07684 6113 9129853
A07904 3452 6767984 PIPE CLIP ABS PAD WEAR IND. CABLE
 
J

Jim Cone

The free Excel add-in "Shade Data Rows" will shade by cell value.
It shades the selection or across entire sheet.
It will also shade by every nth row or every group of n rows.
Choice of any color.
Download from ... http://www.realezsites.com/bus/primitivesoftware
No registration required.
--
Jim Cone
San Francisco, USA


Hi, i have document numbers in column "A", all like numbers must be the
same color e.g.
rows 1, 2, 3, 4 white then 5 grey, 6 white, 7 & 8 grey etc..
I would like to do this with code as the length of data is variable and
automatically created..

1.A03697 1712 7531581 ASSY HSE BTW RADIATOR RETURN & THERM/HSG
2.A03697 1362 1433077 TEMPERATURE SENSOR WATER, CLIPSE ATTACHM
3.A03697 6111 6938076 MDL TEMP SENSOR E9X N46+NG6/N52
4.A03697 1713 7543026 AY COOLANT EXPANSION TANK L2 SP-IG.ENGIN
5.A04933 3610 6775592 STEEL WHEEL 7JX16 EH2 IS34 STYL 12)
6.A07050 5175 7128503 SEAL RADIATOR
7.A07110 2120 9901023 PAN SCREW M8X16-8.8-ZNS
8.A07110 2151 1203012 KNURLED-HEAD BOLT
A07346 5121 7059891 LU UNIFORM LOCK SYSTEM LHD
A07346 6612 6937508 ADAPTER PURSE KEY PL2
A07346 5116 7075474 ASSY GLOVE BOX CPL A COL
A07684 6113 9129853
A07904 3452 6767984 PIPE CLIP ABS PAD WEAR IND. CABLE
 
L

Les Stout

Sub test()
Dim rngToColour As Range
Dim varLastValue As Variant
Dim intColour1 As Integer
Dim intColour2 As Integer
Dim intCurrentColour As Integer
Dim LstRow As Long
intColour1 = 2
intColour2 = 3
intCurrentColour = intColour1
LstRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
Set rngToColour = Sheet1.Range("A2:p" & LstRow)
varLastValue = rngToColour.Value(1, 1)
Do While rngToColour.Value("A2:p" & LstRow) <> ""
rngToColour.Interior.ColorIndex = intCurrentColour
If rngToColour.Value("A2:p" & LstRow) <> varLastValue Then
If intCurrentColour = intColour1 Then
intCurrentColour = intColour2
Else
intCurrentColour = intColour1
End If
varLastValue = rngToColour.Value(1, 1)
End If
Set rngToColour = rngToColour.Offset(1, 0)
Loop
End Sub

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***
 
S

SweetSpot

The xlsweetspot guy says: "Here are some codes that should work without
modification. You just have to decide what column/cell should be used
as the starting point. The code will do the rest."

Sub ColorWhenValueChange()
'The xlsweetspot guy would would do it this way.
Dim strActiveAddress As String 'Use this to track single cell position
ActiveCell.Offset(1, 0).Select
Do While Len(ActiveCell.Value) <> 0 ' This will run until a row is
blank.
strActiveAddress = ActiveCell.Address
' Compare the values in the current cell with the one above
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
ActiveCell.EntireRow.Offset(-1, 0).Copy
ActiveCell.EntireRow.PasteSpecial xlPasteFormats
Else
If ActiveCell.Offset(-1, 0).Interior.ColorIndex = xlNone Then
ActiveCell.EntireRow.Select
Selection.Interior.ColorIndex = 15
Else
ActiveCell.EntireRow.Select
Selection.Interior.ColorIndex = xlNone
End If
End If
Range(strActiveAddress).Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub

There is also a row coloring product at xlsweetspot.com that might
solve some concerns.

Good Luck,
(e-mail address removed)
 
L

Les Stout

Sweet, thanks a lot works great, just did a small modification.

If ActiveCell.Offset(-1, 0).Interior.ColorIndex = xlNone Then
ActiveCell.EntireRow.Interior.ColorIndex = 15
Else
ActiveCell.EntireRow.Interior.ColorIndex = xlNone
End If


Les Stout

*** Sent via Developersdex http://www.developersdex.com ***
 
Top