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.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.