Page tree

Welcome to FreeSoftwareServers Confluence Wiki

Skip to end of metadata
Go to start of metadata
Sub Dup_Finder()
Dim wb As Workbook, ws As Worksheet

Set wb = ActiveWorkbook
Set sSheet = wb.ActiveSheet

Dim sExists As Boolean
sExists = WorksheetExists("Dups")
If sExists = False Then
With wb
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Dups"
End With
End If
    
Set dSheet = wb.Worksheets("Dups")

With dSheet
      j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

Dim rcell As Range, rng As Range, urng As Range
Set urng = sSheet.Application.InputBox("Select a range or a column", "Obtain Range Object", Type:=8)
Set rng = sSheet.Range(Col_Letter(urng.Column) & "1:" & Col_Letter(urng.Column) & Cells(Rows.Count, urng.Column).End(xlUp).Row)
For Each rcell In rng
    If WorksheetFunction.CountIf(rng, rcell.Value) > 1 Then
        'rcell.Style = "Bad" ' Highlight Red
        rcell.EntireRow.Copy Destination:=dSheet.Range("A" & j)
        j = j + 1
    End If
Next rcell

Dup_Cond_Form (sSheet.Range(Col_Letter(urng.Column) & "1:" & Col_Letter(urng.Column) & Cells(Rows.Count, urng.Column).End(xlUp).Row))

dSheet.Select

End Sub

Function Col_Letter(lngCol As Long) As String
    Dim vArr
    vArr = Split(Cells(1, lngCol).Address(True, False), "$")
    Col_Letter = vArr(0)
End Function

Function WorksheetExists(sName As String) As Boolean
    WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
End Function

Sub Dup_Cond_Form(rng As Range)

    rng.FormatConditions.AddUniqueValues
    rng.FormatConditions(rng.FormatConditions.Count).SetFirstPriority
    rng.FormatConditions(1).DupeUnique = xlDuplicate
    With rng.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With rng.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    rng.FormatConditions(1).StopIfTrue = False

End Sub
  • No labels