[Spirosgr]

Καλημέρα.
Μάνο, ο καλύτερος τρόπος, για να λύσουμε ένα πρόβλημα,
είναι εξ' αρχής, να γνωρίζουμε, τι θα πρέπει να κάνουμε στο τέλος.
Το να «εντοπίσουμε» τις διπλοεγγραφές, θα έχει και συνέχεια;
Πχ διαγραφή;
Ακόμα,
το να «εντοπίσουμε» τις διπλοεγγραφές, έχει κάποιους ... ας πούμε περιορισμούς.
Ο κώδικας παρακάτω για παράδειγμα, χρησιμοποιεί για τον «εντοπισμό», χρώματα.
Τι γίνεται όμως, αν ο χρήστης, έχει ήδη χρώματα στο φύλλο του;
Το ίδιο, μπορεί να συμβεί, αν για παράδειγμα, αλλάξει χρώμα η γραμματοσειρά.


Πρόταση 1
Μετά την τελευταία στήλη, (στην 30 η) βάλε Concatenate και εντόπισε τα διπλότυπα,
με Conditional Formatting
Πρόταση 2
Έχοντας κάνει την πρώτη ενέργεια, μπορείς να:
Μετά την νέα τελευταία στήλη, (στην 31 η) βάλε CountIf και «μέτρα»,
ποια κελιά της 30 ης, είναι >1.
Με φίλτρο, ως προς >1, μπορείς να έχεις «πιάτο», μόνο τις διπλοεγγραφές.
Αποφασίζεις τότε, τι θα τις κάνεις...
Πρόταση 3
Ο παρακάτω κώδικας, για να μπορέσει να τρέξει, «θέλει» να ενεργοποιηθεί από το Tools >> References
το Microsoft Scripting Runtime.
Μερικές πληροφορίες:
Χρησιμοποιεί, διπλό χρωματισμό για:
Πρώτη εγγραφή (ΚΙΤΡΙΝΟ) - επόμενες διπλότυπες εγγραφές (ΠΡΑΣΙΝΟ)
*Τα χρώματα, μπορεί να αλλάξουν αν θέλει ο χρήστης.
Δεν υπολογίζει ως διπλότυπα, κενές γραμμές.
Σημείωση:
Το μικρό κωδικάκι επαναφέρει τα χρώματα σε ... «τίποτα».

Option Explicit
'Να ενεργοποιηθεί το Microsoft Scripting Runtime
'Tools >> References
Sub HighDupes()
    Dim iWSt As Worksheet
    Dim iRow As Range
    Dim iCol As Range
    Dim NewString As String
    Dim iDictionary As Dictionary
    Set iDictionary = New Dictionary
    Set iWSt = Sh1
    Application.ScreenUpdating = False
    For Each iRow In iWSt.UsedRange.Rows
        'Αν οι γραμμές είναι κενές (Blank Rows) τότε skip
        If Application.CountA(iWSt.Rows(iRow.Row)) > 0 Then
            NewString = "Ο_ΤΙΤΛΟΣ_ΤΟΥ_ΦΥΛΛΟΥ" 'ΧωρίςΚενά - εννοείται και στο φύλλο ...
            For Each iCol In iWSt.UsedRange.Columns
                NewString = NewString & "||" & iWSt.Cells(iRow.Row, iCol.Column)
            Next
            If iDictionary.exists(NewString) Then
                'Διπλός χρωματισμός: Πρώτης εγγραφής - επόμενων εγγραφών
                iWSt.Rows(iRow.Row).Interior.Color = vbYellow 'ΚΙΤΡΙΝΟ
                iWSt.Rows(iDictionary(NewString)).Interior.Color = vbGreen ' ΠΡΑΣΙΝΟ
            Else
                iDictionary.Add NewString, iRow.Row
            End If
        End If
    Next
    Application.ScreenUpdating = True
    Set iDictionary = Nothing
    Set iWSt = Nothing
End Sub

'Επαναφορά χρωμάτων
Sub ColorReset()
    Application.ScreenUpdating = False
    ActiveSheet.Cells.Interior.Color = xlNone
End Sub