Snasui Excel Forum

Code: Select all

Sub CK_DUP()
    Dim Cell As Range
    Dim Source As Range
    Dim Source1 As Range
    With Sheets("Sheet1")
        Set Source = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
        For Each Cell In Source
            Cell.Offset(0, 1).Value = Abs(Cell.Value)
        Next Cell
        Set Source1 = Source.Offset(0, 1)
        For Each Cell In .Range("b2", .Range("b" & .Rows.Count).End(xlUp))
            If Application.WorksheetFunction.CountIf(Source1, Cell) > 1 Then
                Cell.Interior.Color = RGB(255, 0, 0)
            End If
        Next Cell
        Source1.ClearContents
     End With
    ' MsgBox (k)
End Sub

Code: Select all

Sub CK_DUP()
    Dim Cell As Range
    Dim Source As Range
    Dim Source1 As Range
    With Sheets("Sheet1")
        Set Source = .Range("e2", .Range("e" & .Rows.Count).End(xlUp))
        For Each Cell In Source
            Cell.Offset(0, 1).Value = Abs(Cell.Value)
        Next Cell
        Set Source1 = Source.Offset(0, 1)
        For Each Cell In Source1
            If Application.WorksheetFunction.CountIf(Source1, Cell) > 1 Then
                Cell.Offset(0, -5).Resize(1, 5).Interior.Color = RGB(255, 0, 0)
            End If
        Next Cell
        Source1.ClearContents
    End With
    ' MsgBox (k)
End Sub

Code: Select all

Sub CK_DUP()
    Dim Cell As Range
    Dim Source As Range
    Dim v1 As Integer
    Dim v2 As Integer
    With Sheets("Sheet1")
    Set Source = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    For Each Cell In Source
        v1 = Application.CountIf(Source, Cell.Value)
        v2 = Application.CountIf(Source, -Cell.Value)
        If Cell.Value = 0 Or (v1 > 0 And v2 > 0 And v1 - v2 = 0) Then
            Cell.Offset(0, 1).Interior.Color = RGB(0, 255, 0)
        End If
    Next Cell
    End With
End Sub