Macro to compare "main row"

[bb86993]

Hello to All
Urgent help needed
1. Workbook (two sheets with numbers)
2. User manually selects range of cells (numbers in same row but different columns)
Example (main selection):
c d e f g h i j k l
1 2 3 4 5 6 7 8 9 10

3. Macro checks both sheets, compares "Main Selection" with other rows and highlights "doubles" (including "main selection")

Example rows (could be different length):
1) 2 5 7 15 27 56 47 74 85 1 10... (2,5,7,1,10 would be highlighted)
2) 1 3 8 4 22 33 55 90 10 6 7 9... (1,3,8,4,10,6,7,9 would be highlighted)

I found macro to compare ActiveCell but don't know how to modify it accordingly. Too far from programming

Sub HighlightCells()
ActiveSheet.UsedRange.Cells.FormatConditions.Delete
ActiveSheet.UsedRange.Cells.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:=ActiveCell
ActiveSheet.UsedRange.Cells.FormatConditions(1).Interior.ColorIndex = 4

End Sub

Thank you in advance
Your help is very appreciated

 

[sergioMabres]

Hi bb try with this

Sub HighlightCells()
    Dim cs, ca As Range
    ActiveSheet.UsedRange.Cells.Interior.ColorIndex = xlAutomatic
    For Each cs In Selection
        For Each ca In ActiveSheet.UsedRange
            If ca.Value = cs.Value Then
                ca.Cells.Interior.ColorIndex = 4
            End If
        Next ca
    Next cs
End Sub

I think it does the trick
Sergio

 

[oldbrewer]

[TABLE="width: 479"]
<colgroup><col span="2"><col><col span="5"></colgroup><tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]5[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD="align: right"]44[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]77[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]99[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]D4>>>>>>[/TD]
[TD="align: right"]0[/TD]
[TD]match[/TD]
[TD="align: right"]0[/TD]
[TD]match[/TD]
[TD="align: right"]0[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]in D4[/TD]
[TD="colspan: 6"]=IF(ISERROR(MATCH(D8,winrange,0))*1,0,"match")[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[oldbrewer]

formatting got scrambled but basically any number in lower row is checked against higher row and 0 appears if no match, match if match is found

 

[bb86993]

Hi Sergio,

Thank you for your quick reply.
Almost perfect but
1. Macro "erases" grid (field with numbers but grid is visible were numbers are not entered yet)
2. It doesn't include second sheet (checks just the active one)

Thank you in advance

 

[sergioMabres]

instead of xlautomatic use 0
like this

Sub HighlightCells()
    Dim cs, ca As Range
    ActiveSheet.UsedRange.Cells.Interior.ColorIndex = 0
    For Each cs In Selection
        For Each ca In ActiveSheet.UsedRange
            If ca.Value = cs.Value Then
                ca.Cells.Interior.ColorIndex = 4
            End If
        Next ca
    Next cs
End Sub

 

[bb86993]

Works great but checks only ActiveSheet
Could it check both of them?
Names :sheet1 & sheet2

Thanks

 

[sergioMabres]

yes it could, let me see

 

[sergioMabres]

Boris, Here it is, now it is checking both sheets first and second sheet

Sub HighlightCells()
    Dim cs, ca As Range
    Dim i As Integer
    For i = 1 To 2
        Sheets(i).UsedRange.Cells.Interior.ColorIndex = 0
        For Each cs In Selection
            For Each ca In Sheets(i).UsedRange
                If ca.Value = cs.Value Then
                    ca.Cells.Interior.ColorIndex = 4
                End If
            Next ca
        Next cs
    Next i
End Sub

Cheers
Sergio

 

[bb86993]

Thank you very much.
All the best

B.