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:
voor de volledigheid geef ik ook nog de code van de sub "unieke lijst"
de onderstaande code werkt niet vanaf 'Create Unique nummerplaat3 List.
Deze lijn wordt aangeduid in het geel :
Hulp is welkom,
Bert
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