View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Gary Keramidas Gary Keramidas is offline
external usenet poster
 
Posts: 2,494
Default Comparing cells, coloring differences

see if something like this would work

Option Explicit

Sub compaer_cells()
Dim i As Long
Dim lastrow As Long
Dim ws As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set ws = Worksheets("Sheet1")
lastrow = ws.Cells(Rows.Count, "B").End(xlUp).Row

For i = 1 To lastrow
If ws.Range("B" & i).Value < ws.Range("C" & i).Value Then
ws.Range("C" & i).Interior.ColorIndex = 35
End If
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

--


Gary


wrote in message
...
I would like to compare adjoining cells (B1 and C1, B2 and C2, etc.),
and change the color of the C cells which are not identical to their B
counterparts.

It would save me an enormous amount of work, but unfortunately I'm not
quite at the point where I can work this sort of thing out by myself.
Any help would be greatly appreciated indeed!

Here's the sort of thing I'm trying, in a Word-based macro:

Sub ColorDifferences()
'compare adjoining cells (B1 and C1, B2 and C2, etc.),
'and change the color of the C cells which are not
'identical to their B counterparts

Dim oTbl As Table
Dim oRow As Row
Dim numRow As Long

If Not Selection.Information(wdWithInTable) Then
MsgBox "Please put the cursor in a table first."
Exit Sub
End If

Set oTbl = Selection.Tables(1)

If Not oTbl.Uniform Then
MsgBox "The macro can't deal with merged or split cells."
Exit Sub
End If

For numRow = 1 To oTbl.Rows.Count
Set oRow = oTbl.Rows(numRow)
With oRow
If Not .HeadingFormat Then
If .Cells(2).Range.Text < .Cells(3).Range.Text Then
.Cells(3).Shading.ForegroundPatternColor =
wdColorRed
End If
End If
End With
Next
End Sub