Makro: Reducering af ens rækker

Har du mulighed for at sende filen eller uddrag heraf?

Er det entydigt nok at sammenligne ens navne?

VBA-kode indsættes under relevante ark /
Overskrifter forventes i række 1 *)
Sorter iflg. kolonne D / E forinden

Public Sub sletDobbeltgængere()
Dim sidsterække As Long, ræk As Long
Dim navn As String, adresse As String
Dim Xnavn As String, Xadresse As String
    sidsterække = ActiveCell.SpecialCells(xlLastCell).Row
       
    Application.ScreenUpdating = False
   
Rem traverser rækker
    For ræk = 2 To sidsterække    'evt. ret til 1 *
        If ræk = 2 Then
            Xnavn = Range("D2")
            Xadresse = Range("E2")
        Else
            navn = Range("D" & ræk)
            adresse = Range("E" & ræk)
Rem hvis blanke - så stop
            If navn = "" And adresse = "" Then
                Exit For
            Else
Rem sammenlign - slet række hvis navn & adresse er ens
                If navn = Xnavn And adresse = Xadresse Then
                    Rows(ræk).Delete
                    ræk = ræk - 1
                Else
                    Xnavn = Range("D" & ræk)
                    Xadresse = Range("E" & ræk)
                End If
            End If
        End If
    Next ræk
End Sub

Du kunne også anvende Excels indbyggede funktionalitet:

ActiveSheet.Range("$A$1:$B$999").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

Ja - det er jo meget nemmere og det virker - kendte ikke denne funktion..

Til Thorp:
Hvor/hvordan skal den indtastes ??

Indsæt nedenstående under dit ark. Du kalder så denne procedurer når du vil bruge den. Du kan også flytte den til et modul og skippe Private foran procedurenavnet.

Private Sub Remove_Dublicates()

Dim MyRange As Variant


ActiveSheet.Range("$D$1").Select
MyRange = Selection.CurrentRegion.Address

ActiveSheet.Range(MyRange).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

End Sub