Rimozione di righe duplicate dopo aver controllato tutte le colonne

Ho scritto la macro sotto per rimuovere le righe duplicate dopo aver controllato tutte le colonne. Pensavo che funzionasse correttamente, in base alla logica, ma l'output non è corretto e alcune delle righe che dovrebbero essere mostrate vengono eliminate. Qualcuno mi può aiutare con questo?

Prima di eseguire questa macro, ho un'altra macro per ordinare i dati da alcune colonne per assicurare che le row simili siano raggruppate, quindi forse la macro può tenerne conto e controllare solo la row sopra di essa invece di controllare tutte le righe ? Molto apprezzare qualsiasi aiuto!

Sub Delete_Repeated_Rows() Dim Rng As Range Dim ColumnCounter As Integer Set Rng = ActiveSheet.UsedRange.Rows 'Using ColumnCounter to hold total number of cells that match. If all of them match, delete row' For r = Rng.Rows.Count To 1 Step -1 ColumnCounter = 0 For Col = Rng.Columns.Count To 1 Step -1 'Loop through columns and find matches' If Application.WorksheetFunction.CountIf(Rng.Columns(Col), Rng.Cells(r, Col)) > 1 Then ColumnCounter = ColumnCounter + 1 End If Next Col If ColumnCounter = Rng.Columns.Count Then Rng.Rows(r).EntireRow.Delete End If Next r End Sub 

Per eliminare il duplicato è sufficiente fare clic sul button "Rimuovi duplicati" in Data Ribbon> Tools Data. immettere qui la descrizione dell'immagine
Di seguito è riportto il demo:
Ho i dati come questo nel foglio di lavoro:
immettere qui la descrizione dell'immagine
Vorrei avere dati univoco alla colonna A
fai clic sul button "Rimuovi duplicati" e la seguente schermata viene aperta e deseleziona la colonna B
immettere qui la descrizione dell'immagine
Fare clic sul button OK e una casella di notifica mi dice che 2 valore duplicato è stato rimosso e 5 valori univoco sono stati trovati come la seguente schermata:
immettere qui la descrizione dell'immagine
Il seguente è il risultato finale:
immettere qui la descrizione dell'immagine

utilizzare il command RemoveDuplicates incorporato. Sarà molto più veloce di un ciclo tra le righe. L'unico trucco nella casella sta passando l'arrays per il parametro delle colonne.

 Sub DeDupe() Dim intArray As Variant, i As Integer Dim rng As Range Set rng = ActiveSheet.UsedRange.Rows With rng ReDim intArray(0 To .Columns.Count - 1) For i = 0 To UBound(intArray) intArray(i) = i + 1 Next i .RemoveDuplicates Columns:=(intArray), Header:=xlYes End With End Sub