probleem met loop en find

[Guess Who]

Hier ben ik weer met een volgend probleempje

De bedoeling is om via "find" en een loop alle plannen te vinden met een bepaald dossiernummer. Deze moeten op een nieuwe worksheet komen en dan deze worksheet tonen (een soort filter dus). Echter de loop zit niet goed want hij stopt niet. En wat meer is hij toont de gegevens van een plan telkens onder elkaar. dus ipv plan1op rij 1, plan 2 op rij 2, .... krijg ik plan1 op rij 1, plan 1 op rij 2, plan1 op rij 3, ...

Kan iemand mij zeggen wat ik verkeerd doe?

Private Sub PlannenBekijken_Click()
Dim DestSheet As Worksheet
Dim Lr As Long
Dim Rij As Long
Dim WegschrijfRij As Long

WegschrijfRij = 2
 
Set DestSheet = Sheets("Archief")
    Lr = Sheets("Archief").Range("c65500").End(xlUp).Row
    
If Range("Archief!T2:T" & Lr).Find(Dossiernummer_Opzoeken.Value) Is Nothing Then
    MsgBox "Dit dossier bestaat niet"
Else
    Do While Not Range("Archief!T2:T" & Lr).Find(Dossiernummer_Opzoeken.Value, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing
    Rij = Range("Archief!T2:T" & Lr).Find(Dossiernummer_Opzoeken.Value, LookIn:=xlValues, LookAt:=xlWhole).Row
    WegschrijfRij = WegschrijfRij + 1
    
    
    Sheets("OPZOEKINGEN").Cells(WegschrijfRij, 1) = Sheets("Archief").Cells(Rij, 1)
    Sheets("OPZOEKINGEN").Cells(WegschrijfRij, 2) = Sheets("Archief").Cells(Rij, 2)
    ....
    Loop
    
    Opzoeken_Op_Dossiernummer.Hide
    MsgBox "Opgelet!! Aanpassingen op volgend blad worden niet opgeslagen!!"
    Blad11.Activate  'blad11 = OPZOEKINGEN
End If

 

[Wigi]

Een autofilter is een veel betere keuze voor dit probleem...

 

[snb]

Of kijk hier

 

[Guess Who]

een autofilter wil ik hiervoor niet gebruiken omdat het werkblad "Archief" verborgen zal worden zodat niemand daar rechtstreeks in kan gaan wijzigen.

 

[snb]

Deze opmerking heeft niets met het gebruik van VBA te maken.

 

[Guess Who]

snb, ik denk dat ik niet helemaal duidelijk geweest ben.
Met de code op jouw link vul je inderdaad telkens een nieuwe barcode op de volgende regel in, maar daar zit mijn probleem niet.

Mijn probleem zit in het feit dat ik met find meer dan 1 rij wil opzoeken in een werkblad, en deze dan op een nieuw werkblad wil weergeven.
Ik heb dus ook maar 1 criteria (dossiernummer) dat op werkblad "Archief" meerdere keren voor komt. Elke rij waar dat dossiernummer in voorkomt wil ik op mijn nieuw werkblad.
Wat mij echter niet lukt is om het volgende record op te zoeken.

 

[snb]

Met

Private Sub PlannenBekijken_Click()
  With Sheets("Archief").[A1].CurrentRegion
    .Rows(1).Copy Sheets("Archief").[BA1]
    Sheets("Archief").[BT2] = Dossiernummer_Opzoeken.Value
    .AdvancedFilter xlFilterCopy, Sheets("Archief").[BA1].CurrentRegion, Sheets("OPZOEKINGEN").Cells(2, 1).Resize(, .Columns.Count)
  End With
  Hide
End Sub

Kun je realiseren wat je wil.
Het maakt daarbij niets uit of het werkblad 'archief' zichtbaar is of niet.

Als je slim bent, maak je geen tekstvak voor het dossiernummer maar een lijstvak, waarin alle dossiernumers voorkomen. Dat voorkomt foute invoer en vereenvoudigt de invoer door de gebruiker (want die hoeft slechts te kiezen).
Alle dossiernummers zet je eenvoudig in het lijstvak met

Private Sub UserForm_Initialize()
    sq = Application.WorksheetFunction.Transpose(Sheets("Archief").cells(1,18).resize(sheets("Archief").usedrange.rows.count))
    lijstvak1.list=sq
End Sub

PS. ik krijg wel kippevel van malalogismen als 'opzoekingen'. Is 'raadpleging' geen alternatief ?

 

[Guess Who]

Als je slim bent, maak je geen tekstvak voor het dossiernummer maar een lijstvak, waarin alle dossiernumers voorkomen. Dat voorkomt foute invoer en vereenvoudigt de invoer door de gebruiker (want die hoeft slechts te kiezen).
Alle dossiernummers zet je eenvoudig in het lijstvak met

Tja, slim ben ik niet, anders had ik hier waarschijnlijk geen vragen moeten stellen en had ik ook woorden als

malalogismen

begrepen

Neenee, ter zake: het is inderdaad een goed idee om deze dossiernummers als een lijstvak weer te geven, wat lukt met jouw code.
Een opmerking daarbij (wat misschien ook wel weer verholpen kan worden). Niet alle plannen habben een dossiernummer en sommige dossiernummers komen meer dan 1 keer voor.
Kan je door jouw code uit te breiden ook maken dat lege vakken niet voor komen in de lijst en nummers die meerdere keren voor komen toch maar 1 keer in de lijst staan?

Alvast bedankt.

 

[snb]

Gebruik advancedfilter om unieke nummers uit een lijst (kolom T -20) te genereren in kolom AL (38).
Zet die in een matrix sq en koppel die aan het lijstvak van het gebruikersformulier.

Private Sub UserForm_Initialize()
  with sheets("archief")
      .Columns(38).ClearContents
      .Columns(20).AdvancedFilter xlFilterCopy, , .Cells(1,38), True
      sq = Split(Join(WorksheetFunction.Transpose(.columns(38).SpecialCells(xlCellTypeConstants)), "|"), "|")
  end with
  lijstvak1.list=sq
End Sub

 

[Guess Who]

om een of andere duistere reden krijg ik steeds een foutmelding.

"De veldnaam in het ophaalbereik ontbreekt of is ongeldig"

Ik snap eigenlijk ook die advancedfilter niet goed. Kan het zijn dat de fout ligt in het volgende?

.cells (1, 7)

 

[snb]

Met cells(1,7) had je gelijk, dat moet natuurlijk kolom 38 zijn.
Vorige suggestie daarop aangepast.
Tevens het nummer van kolom T (20) aangepast.

 

[Guess Who]

Ik heb toch nog een klein beetje moeten sleutelen aan de code. Blijkbaar heeft "transpose" problemen met lege cellen, en heb ik de lijst eerst nog gesorteerd ook.

Private Sub UserForm_Activate()
Dossiernummer_Opzoeken = ""

With Sheets("archief")
      .Columns(38).ClearContents
      .Columns(20).AdvancedFilter xlFilterCopy, , .Cells(1, 40), True
      [COLOR="Red"].Cells(2, 38) = "-"
      .Columns("AN:AN").Sort Key1:=Worksheets("Archief").Range("AN1"), order:=xlAscending, Header:=xlGuess[/COLOR]
      sq = Split(Join(WorksheetFunction.Transpose(.Columns(38).SpecialCells(xlCellTypeConstants)), "|"), "|")
  End With
  listbox1.List = sq
End Sub

Hoewel ik hier liever de lege cell (2, 38) had verwijderd.

 

[Guess Who]

Gevonden !!

.Range("AN1:AN2").Delete shift:=xlShiftUp

Bedankt voor jouw (weeral eens) deskundige hulp. :thumb: :thumb:

 

[snb]

bepaal of je met kolom 38 of 40 wil werken:
Als je met kolom 38 wil werken

Private Sub UserForm_Activate()
  Dossiernummer_Opzoeken = ""

  With Sheets("archief")
    .Columns(38).ClearContents
    .Columns(20).AdvancedFilter xlFilterCopy, , .Cells(1, [COLOR="Red"]38[/COLOR]), True
    .Columns([COLOR="red"]38[/COLOR]).Sort [COLOR="red"].Cells(1,38)[/COLOR]
    sq = Split(Join(WorksheetFunction.Transpose(.Columns(38).SpecialCells(xlCellTypeConstants)), "|"), "|")
  End With
  listbox1.List = sq
End Sub

Als je sorteert hoef je geen lege cellen te verwijderen, omdat die niet tussen gevulde komen te staan. Transpose werkt alleen maar op een ononderbroken gebied (een 'range' met slechts 1 'area').

 

[Guess Who]

weer een beetje wijzer geworden. Bedankt