Fout in module

[toverkamp]

Hallo forum,

Ik ben bezig met het maken van een zoekformulier. Hierin moet gezocht worden op plaats. de plaats kan gezocht worden door middel van een combobox. Maar nu zit ik met een probleem.
Ferenc heeft in een ander topic al een bestandje gemaakt. Hierin staat een module, en in het bestand is een nieuw werkblad "verborgen" aangemaakt.
Om de combobox te "vullen" met plaatsnamen moet ik dmv de module alle unieke plaatsnamen vinden. Dat doe ik met de door Ferenc gegeven code:

Sub SoorteerEnVerwijderDubbelenPlaats()
Dim rListSort As Range, rOldList As Range
Dim strRowSource As String

 'Clear Hidden sheet Column A ready for list
  Sheets("verboden").Range("A1", Sheets("verboden").Range("E65536").End(xlUp)).Clear
  
 'Set range variable to list we want
  Set rOldList = Sheets("database filiaal").Range("D4", Sheets("database filiaal").Range("D100").End(xlUp))

 'Use AdvancedFilter to copy the list to Column A _
  of the hidden sheet and remove all dupes
  rOldList.AdvancedFilter Action:=xlFilterCopy, _
               CopyToRange:=Sheets("verboden").Cells(1, 2), Unique:=True
               
 'Set range variable to the new non dupe list
  Set rListSort = Sheets("verboden").Range("B1", Sheets("verboden").Range("B65536").End(xlUp))

    With rListSort
             'Sort the new non dupe list
             .Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
    
     'Parse the address of the sorted unique items
           strRowSource = Sheets("verboden").Name & "!" & Sheets("verboden").Range _
           ("B2", Sheets("verboden").Range("B65536").End(xlUp)).Address
   
    Sheets("verboden").Range("B1") = "Plaats"
   With zoekenopnaamplaats.zoekennaamplaatsplaats
      'Clear old ListBox RowSource
      .RowSource = vbNullString
      'Parse new one
      .RowSource = strRowSource
  End With
  
End Sub

Maar nu geeft VBA aan dat er een fout zit in de volgende regel van die code:

  rOldList.AdvancedFilter Action:=xlFilterCopy, _
               CopyToRange:=Sheets("verboden").Cells(1, 2), Unique:=True

Heeft iemand enig idee wat hier fout aan is?
Alvast bedankt.

 

[Demeter]

Toverkamp,

Gebruik je het bestand wat ik er toen aan heb gehangen?
Heb je een blad 'verboden' en is deze helemaal leeg?
Deze code zou het wel moeten doen.


Groet,
Ferenc

ps.
De uitleg, in het groen, is niet ok, code gebruikt kolom b op het blad verboden (Cells(1, 2))

 

[toverkamp]

Toverkamp,

Gebruik je het bestand wat ik er toen aan heb gehangen?
Heb je een blad 'verboden' en is deze helemaal leeg?
Deze code zou het wel moeten doen.


Groet,
Ferenc

ps.
De uitleg, in het groen, is niet ok, code gebruikt kolom b op het blad verboden (Cells(1, 2))

Hoi Ferenc,
Ik gebruikte niet hetzelfde bestand. Ik had de formule gekopieerd naar mijn eigen bestand en een worksheet verboden aangemaakt (die helemaal leeg is). Ik dacht dat ie 't dan ook zou moeten doen, maar dit is dus niet het geval? Maar in jou bestand is verboden niet leeg, daar staat namelijk nog in kolom B, zwolle, middelburg, amsterdam en groningen. Hoort dat ook daar te staan?

 

[Demeter]

Je code saat op een module?
Er bestaat ook een blad 'database filiaal'?

Heb je de code op je annuleer knop op zoekenopnaamplaats form:

Private Sub annuleer_Click()
Sheets("verboden").Cells.Clear
Unload Me
End Sub

ook meegenomen. Deze leegt de gegevens op blad verboden als je afsluit.

 

[toverkamp]

Je code saat op een module?
Er bestaat ook een blad 'database filiaal'?

Heb je de code op je annuleer knop op zoekenopnaamplaats form:

Private Sub annuleer_Click()
Sheets("verboden").Cells.Clear
Unload Me
End Sub

ook meegenomen. Deze leegt de gegevens op blad verboden als je afsluit.

Nee die had ik nog niet meegenomen, maar ik heb nu het bestand wat u hier heeft gepost in gebruik met wat enkele aanpassingen. Nu ik dat heb gedaan, krijg ik weer dezelfde foutmelding. En het verboden werkblad is niet meer leeg als je ergens op hebt gezocht klopt dat?

 

[toverkamp]

Ik heb het probleem opgelost!

Ferenc bedankt!:thumb:

 

[toverkamp]

Ferenc,

Ik heb nu de echt database erin gevoegd. Dit zijn zo'n 220 filialen, met bijna evenveel plaatsen (er zitten ook dubbele plaatsen tussen). Maar nu komt hetzelfde probleem weer terug. In de code:

Sub SoorteerEnVerwijderDubbelenPlaats()
Dim rListSort As Range, rOldList As Range
Dim strRowSource As String

 'Clear Hidden sheet Column A ready for list
  Sheets("verboden").Range("A1", Sheets("verboden").Range("E65536").End(xlUp)).Clear
  
 'Set range variable to list we want
  Set rOldList = Sheets("database filiaal").Range("D4", Sheets("database filiaal").Range("D100").End(xlUp))

 'Use AdvancedFilter to copy the list to Column A _
  of the hidden sheet and remove all dupes
  rOldList.AdvancedFilter Action:=xlFilterCopy, _
               CopyToRange:=Sheets("verboden").Cells(1, 2), Unique:=True
               
 'Set range variable to the new non dupe list
  Set rListSort = Sheets("verboden").Range("B1", Sheets("verboden").Range("B65536").End(xlUp))

    With rListSort
             'Sort the new non dupe list
             .Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
    
     'Parse the address of the sorted unique items
           strRowSource = Sheets("verboden").Name & "!" & Sheets("verboden").Range _
           ("B2", Sheets("verboden").Range("B65536").End(xlUp)).Address
   
    Sheets("verboden").Range("B1") = "Plaats"
   With zoekenopnaamplaats.zoekennaamplaatsplaats
      'Clear old ListBox RowSource
      .RowSource = vbNullString
      'Parse new one
      .RowSource = strRowSource
  End With
  
End Sub

zit de fout in de code:

  rOldList.AdvancedFilter Action:=xlFilterCopy, _
               CopyToRange:=Sheets("verboden").Cells(1, 2), Unique:=True