probleem refresh unieke lijsten zonder afsluiten userform

Status
Niet open voor verdere reacties.

eurotax

Gebruiker
Lid geworden
27 feb 2007
Berichten
25
Ik heb een userform die bij het activeren enkele unieke lijsten voor comboboxen aanmaakt. Dit werkt.

Als ik data wijzig en opsla zou één specifieke combox (nummerplaat3) moeten refreshen Dit omdat er items uit die lijst moeten verdwijnen.

Dit lukt door de userform telkens af te sluiten en terug te activeren.

Maar als ik dezelfde code als bij "Userform_activate" hergebruik in de sub "opslaanreg" met de bedoeling een refresh te krijgen zonder dat ik eerst de userform moet afsluiten, dan krijg ik steeds een foutmelding: "methode sort van klasse range mislukt"
deze code werkt bij het opstarten:

Code:
Private Sub UserForm_Activate()
 
 With tabel4
    
        'Clear range ready for unique lists
       tabel5.Range("A1:AF65000").ClearContents
       tabel4.Range("J1:K65000").ClearContents
       tabel3.Range("J1:K65000").ClearContents

        'Create Unique Naam2 List
       .Range("C2", .Range("C2").End(xlDown)).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:="", CopyToRange:=tabel5.Range("U1"), Unique:=True
        tabel5.Range("U1").CurrentRegion.Offset(1, 0).Name = "Namenlijst2"
        Range("Namenlijst2").Sort Key1:=Range("Namenlijst2").Cells(1, 1), Order1:=xlAscending, Header:=xlNo
        naam2.RowSource = "Namenlijst2"
        
        
        'Create Unique Bedrijf2 List
       .Range("D2", .Range("D2").End(xlDown)).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:="", CopyToRange:=tabel5.Range("W1"), Unique:=True
        tabel5.Range("W1").CurrentRegion.Offset(1, 0).Name = "bedrijvenlijst2"
        Range("bedrijvenlijst2").Sort Key1:=Range("bedrijvenlijst2").Cells(1, 1), Order1:=xlAscending, Header:=xlNo
        bedrijf2.RowSource = "bedrijvenlijst2"
        
        
          'Create Unique nummerplaat2 List
       .Range("B2", .Range("B2").End(xlDown)).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:="", CopyToRange:=tabel5.Range("Y1"), Unique:=True
        tabel5.Range("Y1").CurrentRegion.Offset(1, 0).Name = "Nummerplaat2"
        Range("Nummerplaat2").Sort Key1:=Range("Nummerplaat2").Cells(1, 1), Order1:=xlAscending, Header:=xlNo
        nummerplaat2.RowSource = "Nummerplaat2"
           
         
        Dim c As Range
        For Each c In tabel4.Range("J2:J" & Range("B" & Rows.Count).End(xlUp).Row)
        If IsEmpty(c.Offset(, -2)) Then c = c.Offset(, -8)
        If IsEmpty(c.Offset(, -4)) Then c = c.Offset(, -8)
        Next
        
        End With
        uniekelijst
        
           'Create Unique nummerplaat3 List
        tabel5.Range("A1").CurrentRegion.Offset(1, 0).Name = "Nummerplaat3"
        Range("Nummerplaat3").Sort Key1:=Range("Nummerplaat3").Cells(1, 1), Order1:=xlAscending, Header:=xlNo
        nummerplaat3.RowSource = "Nummerplaat3"
End Sub

voor de volledigheid geef ik ook nog de code van de sub "unieke lijst"

Code:
Sub uniekelijst()

    Sheets(tabel4).Columns("J:J").Copy
 
    Sheets(tabel5).Select
    Columns("A:A").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A1").Select
    Selection.Insert Shift:=xlDown
End Sub


de onderstaande code werkt niet vanaf 'Create Unique nummerplaat3 List.



Code:
Private Sub opslaanreg_Click()

        'Opslaan van de gegevens op specifieke plaatsen

        If tijdstipin.Caption <> "" Then
        
              
            If Not tabel4.Columns("J:J").Find(What:=nummerplaat3.Text, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Offset(0, -4).Value <> Empty Then

            tabel4.Columns("J:J").Find(What:=nummerplaat3.Text, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Offset(0, -4).Value = Now()
    
            tabel4.Columns("J:J").Find(What:=nummerplaat3.Text, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Offset(0, -5).Value = Now()
            
            tabel3.Columns("J:J").Find(What:=nummerplaat3.Text, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Offset(0, -4).Value = Now()
    
            tabel3.Columns("J:J").Find(What:=nummerplaat3.Text, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Offset(0, -5).Value = Now()
            
            End If
        End If

        If tijdstipuit.Caption <> "" Then
        
               
            If Not tabel4.Columns("J:J").Find(What:=nummerplaat3.Text, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Offset(0, -2).Value <> Empty Then
            
            tabel4.Columns("J:J").Find(What:=nummerplaat3.Text, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Offset(0, -2).Value = Now()
            
            tabel4.Columns("J:J").Find(What:=nummerplaat3.Text, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Offset(0, -3).Value = Now()
            
            tabel3.Columns("J:J").Find(What:=nummerplaat3.Text, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Offset(0, -2).Value = Now()
            
            tabel3.Columns("J:J").Find(What:=nummerplaat3.Text, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Offset(0, -3).Value = Now()
            
            End If
        End If
 
      'Refresh van de unieke lijsten van de comboboxen

 With tabel4
    
        'Clear range ready for unique lists
       tabel5.Range("A1:AF65000").ClearContents
       tabel4.Range("J1:K65000").ClearContents
       tabel3.Range("J1:K65000").ClearContents

        'Create Unique Naam2 List
       .Range("C2", .Range("C2").End(xlDown)).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:="", CopyToRange:=tabel5.Range("U1"), Unique:=True
        tabel5.Range("U1").CurrentRegion.Offset(1, 0).Name = "Namenlijst2"
        Range("Namenlijst2").Sort Key1:=Range("Namenlijst2").Cells(1, 1), Order1:=xlAscending, Header:=xlNo
        naam2.RowSource = "Namenlijst2"
        
        
        'Create Unique Bedrijf2 List
       .Range("D2", .Range("D2").End(xlDown)).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:="", CopyToRange:=tabel5.Range("W1"), Unique:=True
        tabel5.Range("W1").CurrentRegion.Offset(1, 0).Name = "bedrijvenlijst2"
        Range("bedrijvenlijst2").Sort Key1:=Range("bedrijvenlijst2").Cells(1, 1), Order1:=xlAscending, Header:=xlNo
        bedrijf2.RowSource = "bedrijvenlijst2"
        
        
          'Create Unique nummerplaat2 List
       .Range("B2", .Range("B2").End(xlDown)).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:="", CopyToRange:=tabel5.Range("Y1"), Unique:=True
        tabel5.Range("Y1").CurrentRegion.Offset(1, 0).Name = "Nummerplaat2"
        Range("Nummerplaat2").Sort Key1:=Range("Nummerplaat2").Cells(1, 1), Order1:=xlAscending, Header:=xlNo
        nummerplaat2.RowSource = "Nummerplaat2"
           
         
        Dim c As Range
        For Each c In tabel4.Range("J2:J" & Range("B" & Rows.Count).End(xlUp).Row)
        If IsEmpty(c.Offset(, -2)) Then c = c.Offset(, -8)
        If IsEmpty(c.Offset(, -4)) Then c = c.Offset(, -8)
        Next
        
        End With
        uniekelijst
        
           'Create Unique nummerplaat3 List
        tabel5.Range("A1").CurrentRegion.Offset(1, 0).Name = "Nummerplaat3"
        Range("Nummerplaat3").Sort Key1:=Range("Nummerplaat3").Cells(1, 1), Order1:=xlAscending, Header:=xlNo
        nummerplaat3.RowSource = "Nummerplaat3"
        
       'leegmaken van de text in de combobox  en labels
        nummerplaat3.Text = Empty
        tijdstipin.Caption = Empty
        dagin.Caption = Empty
        tijdstipuit.Caption = Empty
        daguit.Caption = Empty

End Sub

Deze lijn wordt aangeduid in het geel :

Code:
Range("Nummerplaat3").Sort Key1:=Range("Nummerplaat3").Cells(1, 1), Order1:=xlAscending, Header:=xlNo

Hulp is welkom,
Bert
 
Dag Eurotax,

Waarom niet gewoon een knop met Opslaan en dan de wijzigingen in de betreffende cellen opbergen?

Gegroet,

Axel.
 
Axel,

die combobox "nummerplaat3" is een lijst met nummerplaten uit een groter geheel die voldoen aan volgende eisen : "tijdstipin en/of tijdstipuit is blanco"
ik kies uit die combobox "nummerplaat3" in "voertuigregistratie", een nummerplaat, vervolgens koppel ik daar een tijdstip aan door op de respectievelijke knop te drukken, aan en wordt deze weggeschreven. Nadien zou de rowsource van die combobox terug moeten geupdate worden. (nu blijft een recent volledig ingevulde nummerplaat staan) dit lukt me nu enkel door de volledige userform te sluiten en terug op te starten. ik zou dat graag onmiddelijk doen. Ik zet even het voorbeeld erbij. misschien is het dan duidelijker.

ps, dit is allemaal geschreven met trial en error, waarschijnlijk kan de programmatie allemaal wel gestroomlijnder maar zover reikt mijn kennis nog niet.
 

Bijlagen

Dag Eurotax,

Heb ik je al niet eens een programma in die richting gestuurd?

Gegroet,

Axel.
 
Hi Alex,

je hebt me al eens iets gestuurd, maar het was een beetje te ingewikkeld om te volgen wat de programmatie juist allemaal deed. Sommige zaken heb ik wel kunnen gebruiken.

Ik heb het nu opgelost door telkens na het opslaan de userform te sluiten. zo gaat het wel. Waarom hij telkens die fout gaf denk ik omdat de sort-opdracht van de range "A:A" in "lijst2", om een of andere reden soms geen data vindt. Waarom die range soms leeg is weet ik nog niet.
 
Dag Eurotax,

Had het even gemeld dat het te ingewikkeld was, dan had ik het met alle plezier even uitgelegd. Want het is niet echt moeilijk, maar volgens mij wel heel handig in het gebruik.

Gegroet,

Axel.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan