PDA

View Full Version : Solved: Compare the active row, to row 10



frank_m
04-07-2012, 09:31 PM
I need to highlight in yellow the cells in row 10 that differ from the corresponding cells in the active row. (columns 1 thru 24)

Edit: No need to spend time on this unless you want to,
because I found some code that looks like it might do what I need at http://www.vb-helper.com/howto_excel_compare_ranges.html
--I'll post back the out come. -- The code does look rather lengthly, so perhaps one of you knows a better method.

Thanks

shrivallabha
04-07-2012, 10:28 PM
Hi Frank,

This seems to work. You will have to fine tune it to suit your requirement.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.ScreenUpdating = False
Application.EnableEvents = False

On Error GoTo EOSub 'No guarantee when event based code will error out

'Reset Row 10 colors everytime selection is made.
With Cells(10, 1).Resize(1, 24)
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlAutomatic
End With

If Application.CountA(Cells(Target.Row, 1).Resize(1, 24)) = 0 Then GoTo EOSub 'Empty Row

For i = 1 To 24 'Hard coded for 24 columns
If Cells(10, i).Value <> Cells(Target.Row, i).Value Then
With Cells(10, i)
.Interior.Color = vbYellow
.Font.Color = vbRed
End With
End If
Next i

EOSub:
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

frank_m
04-07-2012, 10:30 PM
Edit: Hi shrivallabha (http://vbaexpress.com/forum/member.php?u=27076), I didn't see you there. Thankyou much, your code is very good and much more compact;
not to mention easier to understand.

The code I found with the aid of google at http://www.vb-helper.com/howto_excel_compare_ranges.htmlis (http://www.vb-helper.com/howto_excel_compare_ranges.html is) is working well.
Plus I was able to shorten it up quite a bit because it was coloring the differences in both rows, and I only need it done in row 10.

Seems like a good piece of code to me, but I don't know much, so feel free to give me any pointers.

Hope I didn't waste anyone's time.

Option Explicit

Private Sub CommandButton4_Click()

Dim range1 As range, range2 As range, cell1 As range, cell2 As range
Dim cells1 As Collection, cells2 As Collection
Dim key As String, no_match As Boolean

Set range1 = ActiveSheet.Cells(10, 1).Resize(, 24)
Set range2 = ActiveSheet.Cells(Selection.Row, 1).Resize(, 24)

' Make normal collections holding the cells.
Set cells1 = New Collection
For Each cell1 In range1.Cells
key = cell1.Row - range1.Row & "," & cell1.Column - range1.Column
cells1.Add cell1, key
Next cell1
Set cells2 = New Collection
For Each cell2 In range2.Cells
key = cell2.Row - range2.Row & "," & cell2.Column - range2.Column
cells2.Add cell2, key
Next cell2
' Examine the cells in the first collection.
For Each cell1 In cells1
On Error Resume Next
Err.Clear
key = cell1.Row - range1.Row & "," & cell1.Column - range1.Column
Set cell2 = cells2(key)
If Err.Number <> 0 Then
' The second cell is missing.
no_match = True
ElseIf cell1.Text <> cell2.Text Then
' The cells don't match.
no_match = True
Else
no_match = False
End If
' If the cells don't match, color cell1.
If no_match Then
With cell1.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
Else
With cell1.Interior
.ColorIndex = xlNone
End With
End If
Next cell1

End Sub

frank_m
04-07-2012, 10:34 PM
Oh wow, you were posting at the same time so I did not see you. Thanks shrivallabha (http://vbaexpress.com/forum/member.php?u=27076), that looks simpler, I'll try it now and post back.

frank_m
04-07-2012, 10:45 PM
HI again shrivallabha (http://vbaexpress.com/forum/member.php?u=27076),

Your code works very well and is certainly a lot more compact :thumb

Thank you much sir :friends:

Bob Phillips
04-08-2012, 04:25 AM
Here is another way


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long

With Target

If .Row <> 10 Then

For i = Me.Rows(10).FormatConditions.Count To 1 Step -1

Me.Rows(10).FormatConditions(i).Delete
Next i

Me.Rows(10).FormatConditions.Add Type:=xlExpression, _
Formula1:="=" & Me.Cells(.Row, "A").Address(False, False) & "<>A$10"
Me.Rows(10).FormatConditions(1).Interior.ColorIndex = 6
End If
End With
End Sub

frank_m
04-08-2012, 09:26 AM
HI Bob,

I can't get that to do anything, (no errors just no result) - is it perhaps written for Excel 2007/2010 ? I'm using 2003

Thank you for your time.

Bob Phillips
04-08-2012, 09:55 AM
This works in 2003 Frank


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long

Application.EnableEvents = True

With Target

If .Row <> 10 Then

For i = Me.Rows(10).FormatConditions.Count To 1 Step -1

Me.Rows(10).FormatConditions(i).Delete
Next i

Me.Cells(.Row, "A").Select

Me.Rows(10).FormatConditions.Add Type:=xlExpression, _
Formula1:="=" & Me.Cells(.Row, "A").Address(True, False) & "<>A$10"
Me.Rows(10).FormatConditions(1).Interior.ColorIndex = 6

Target.Select
End If
End With

Application.EnableEvents = False
End Sub

frank_m
04-08-2012, 10:22 AM
HI Bob,

When I initially click on a row other than row 10, the code works. But when I then click on a different row, (also not row 10), it does nothing. - At that point it does nothing no matter what row I select, regardless of the values being different, or equal, or changed.

I've attached a sample workbook.

Bob Phillips
04-08-2012, 10:51 AM
I messed up the events setting Frank.

This corrects it but you will need to do

Application.EnableEvents = True

in the immediate window


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long

Application.EnableEvents = False

With Target

If .Row <> 10 Then

For i = Me.Rows(10).FormatConditions.Count To 1 Step -1

Me.Rows(10).FormatConditions(i).Delete
Next i

Me.Cells(.Row, "A").Select

Me.Rows(10).FormatConditions.Add Type:=xlExpression, _
Formula1:="=" & Me.Cells(.Row, "A").Address(True, False) & "<>A$10"
Me.Rows(10).FormatConditions(1).Interior.ColorIndex = 6

Target.Select
End If
End With

Application.EnableEvents = True

End Sub

frank_m
04-08-2012, 11:00 AM
HI again Bob,

That certainly did the trick. - Your code works a treat now. :bow:

Thank you much and hope you have a grand day.