rijen verbergen

[madmuppet]

ik zit wat te knoeien met een adressenbestand. Ik heb een HELE lange lijst met gegevens, waaraan namen en adressen gekoppeld zitten. Probleem: veel van die adressen komen meerdere keren voor, in willekeurig aantal op willekeurige plaatsen in dat bestand. Ik wil echter ook graag een lijst hebben met daarin alle unieke gegevens.
Na wat VBA geknutsel is het me gelukt om alle dubbele waarden uit het bestand te verwijderen met een klein macrootje. Prachtig, maar één probleempje: ze worden verwijderd.

Ik zou het prettig vinden als ik het macrootje zo kon maken, dat de dubbele rijen alleen verborgen worden. Heb een tijdje zitten knoeien, maar het lukt niet. Wat doe ik verkeerd?

Private Sub CommandButton1_Click()
Application.Calculation = xlManual

On Error Resume Next
Rij = ActiveCell.Row
kolom = ActiveCell.Column
Do While Cells(Rij, kolom) <> ""
If Trim(Cells(Rij, kolom).Value) = Trim(Cells(Rij + 1, kolom)) Then
Rows(Rij).Select
Selection.EntireRow.Hidden = True (<<< hier gaat het fout. Alleen de eerte dubbele rij wordt verborgen, lijst schuift niet op naar boven....)
'Selection.Delete Shift:=xlUp (<<< dit is de originele regel, die VERWIJDERT de dubbele rijen)
Else
Rij = Rij + 1
End If
Loop
Cells(1, kolom).Select

Application.Calculation = xlAutomatic

End Sub

 

[Wigi]

Probeer eens met Data > Uitgebreid filter

 

[Ginger]

Madmuppet, als ik zo (ongetest) je code bekijk zet je jezelf in een oneindige loop met dit stukje code

If Trim(Cells(Rij, kolom).Value) = Trim(Cells(Rij + 1, kolom)) Then
Rows(Rij).Select
Selection.EntireRow.Hidden = True (<<< hier gaat het fout. Alleen de eerte dubbele rij wordt verborgen, lijst schuift niet op naar boven....)
'Selection.Delete Shift:=xlUp (<<< dit is de originele regel, die VERWIJDERT de dubbele rijen)
Else
Rij = Rij + 1
End If

Wat de code namelijk in het if-statement blijft doen, is de 2 dubbele regels vergelijken bij het vinden van een dubbele regel (ook al is deze inmiddels verborgen). Mijns inziens moet je het 'else' gewoon vervangen voor 'end if' want je wilt toch na iedere actie (dubel gevonden of niet...) je 'Rij' met 1 verhogen. Dit samen met je 'on error resume next' geef je dus aan 'blijf maar lekker doorgaan zonder dat er iets gebeurt'...

Het zou er dus zo moeten uitzien (let op: NIET getest)

Private Sub CommandButton1_Click()
Application.Calculation = xlManual

'On Error Resume Next
Rij = ActiveCell.Row
kolom = ActiveCell.Column
Do While Cells(Rij, kolom) <> ""
If Trim(Cells(Rij, kolom).Value) = Trim(Cells(Rij + 1, kolom)) Then
Rows(Rij).Select
Selection.EntireRow.Hidden = True (<<< hier gaat het fout. Alleen de eerte dubbele rij wordt verborgen, lijst schuift niet op naar boven....)
'Selection.Delete Shift:=xlUp (<<< dit is de originele regel, die VERWIJDERT de dubbele rijen)
End if
Rij = Rij + 1

Loop
Cells(1, kolom).Select

Application.Calculation = xlAutomatic

End Sub

Groet, Leo

 

[madmuppet]

@ Wigi: dat heb ik geprobeerd, maar lukt niet.

@ Ginger: Je hebt gelijk. Probleem is een eindeloze loop inderdaad. Deze macro werkt natuurlijk prima zolang de dubbele rijen verwijderd worden, maar als ze alleen verborgen worden, worden ze eindeloos opniew gevonden.

probleem opgelost, dankjewel!