Problemen met Loop ... while functie

[MAWE]

Hallo,

Ik heb een programma geschreven voor een "zoek button" op sheet (zoek op) die moet zoeken in sheet (Invoer). Alles wat er gevonden wordt, moet gekopieerd worden naar
sheet (zoek op). Probleem zit in de Loop ... while.
Hier heb ik aangegeven dat de loop moet stoppen zodra de laatst gekopierde cel hetzelfde is als de eerste en deze active cel moet dan verwijderd worden.
Probleem doet zich voor als in kolom A meerder cellen zijn met dezelfde inhoud. Functie stopt dus voor alle cellen zijn bekeken.

Zoals in onderstaande programma te zien is heb ik niet veel verstand van VBA. Ik heb alles via andere programma's gevonden en met trail en error ben ik tot hier gekomen.

Ik hoop dat iemand mij kan helpen.

(zie hier een stukje van sheet invoer:

Titel Lb# oud Lb# nieuw ENS# Lokatie Print datum
PGCS 13, C524A LL10-0008 LL10-0061 10001021 P0.130 7-Jan-10
Bagstation 1 LL08-0808 LL09-1197 10058644 D0.513 NA
Bagstation 2 LL09-0503 LL10-0350 10058645 D0.513 12-Mar-10
Bagstation 3 LL09-0502 LL10-0348 10058643 D0.524 12-Mar-10
Balance LL09-0306 LL10-0209 10016909 P0.112A 5-Feb-10
Balance hold bag 1 LL09-0513 LL10-0352 10059686 D0.513 12-Mar-10
Balance hold bag 2 LL09-0514 LL10-0349 10059699 D0.513 12-Mar-10
Balance hold bag 3 LL09-0515 LL10-0351 10059712 D0.524 12-Mar-10
Balans LL09-0998 LL10-0130 10044081 P0.125 22-Jan-10
Balans LL09-0272 LL09-1573 10044084 P0.129D 21-Dec-09

MvrG,

MAWE

Private Sub cmdZoek_Click()
Application.ScreenUpdating = False
Sheets("Invoer").Select
Range("A1").Activate


mawe
zoek = txtZoek.Text

Do
Sheets("Invoer").Select

Cells.Find(What:=txtZoek.Text, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate

Selection.EntireRow.copy

Sheets("Zoek op").Activate
i = 4

Do Until Sheets("Zoek op").Cells(i, 1) = ""
i = i + 1
Loop


Cells(i, 1).Select
ActiveSheet.paste


Loop While Sheets("Zoek op").Cells(i, 1) <> Sheets("Zoek op").Cells(4, 1)


zoek = txtZoek.Text

Do
Sheets("Invoer").Select
Cells.Find(What:=txtZoek.Text, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate

Selection.EntireRow.copy

Sheets("Zoek op").Activate
i = 4

Do Until Sheets("Zoek op").Cells(i, 1) = ""
i = i + 1
Loop


Cells(i, 1).Select
ActiveSheet.paste


Loop While Sheets("Zoek op").Cells(i, 1) <> Sheets("Zoek op").Cells(4, 1)



Selection.EntireRow.Delete



Application.ScreenUpdating = True

End Sub

 

[snb]

Je kunt in het werkblad 'invoer' filteren (autofilter) op txtZoek.text
Kopieer de zichtbare rijen naar werkblad 'zoek op'.
Neem deze handelingen op met de macrorecorder en wied daarna de code.

Hetzelfde kan (zelfs nog eenvoudiger) met uitgebreid filter.

 

[MAWE]

Je kunt in het werkblad 'invoer' filteren (autofilter) op txtZoek.text
Kopieer de zichtbare rijen naar werkblad 'zoek op'.
Neem deze handelingen op met de macrorecorder en wied daarna de code.

Hetzelfde kan (zelfs nog eenvoudiger) met uitgebreid filter.

Op deze manier kan ik alleen hele titels kiezen (toch). Met de vorige txt.Zoek is het ook mogelijk om op een gedeelte van een woord (bala voor balans, balance etc.) te zoeken.

 

[snb]

Daarin vergis je je.
Kijk ook eens in de hulpfunktie van de VBEditor (F1)