Foutmelding bij opslaan userform en tegelijkertijd sorteren van het tabblad.

[EJProsman]

Beste kenners, in een Excel programma heb ik een userform met VBA. De gebruiker kan een jaar en een week selecteren voor zijn input. Om het voor de gebruiker makkelijker te maken komt bij de gekozen jaar/week de begin en einddatum in beeld. Deze worden gehaald uit een tabblad met jaarnummers, weeknummers en begin- en einddatum voor deze week. Hier gebruik ik onderstaande codes voor:

Private Sub ComboBox2_Change()
    FillInStartdate
    FillInEnddate
'Deze Sub zorgt ervoor dat bij de gekozen invoerweek de datum kan komen staan. Deze is nodig voor de Subs FillInStartdate en
    'FillInEnddate
End Sub

Private Sub ComboBox3_Change()
    FillInStartdate
    FillInEnddate
'Deze Sub zorgt ervoor dat bij de gekozen invoerweek de datum kan komen staan. Deze is nodig voor de Subs FillInStartdate en
    'FillInEnddate
End Sub

Private Sub FillInStartdate()
Dim rLookup As Range
Dim nRow As Long
Dim nCol As Long

    If DataPresent Then
        
        With Sheets("Weekstarts")
            'zoekgebied:
 [B][COLOR="#8b0000"]           Set rLookup = .Range("b1", .Cells.SpecialCells(xlCellTypeLastCell))[/COLOR][/B]
            On Error GoTo Unknown:    'er treedt een fout op als er geen _
                                        waarden worden gevonden
            '   rij zoeken:
            nRow = rLookup.Columns(1).Find(ComboBox3.Value, _
                                            Lookat:=xlWhole, _
                                            LookIn:=xlValues, _
                                            MatchCase:=False).Row
            '   kolom zoeken:
            nCol = rLookup.Rows(2).Find("StartDate" & ComboBox2.Value, _
                                            Lookat:=xlWhole, _
                                            LookIn:=xlValues, _
                                            MatchCase:=False).Column - 1
            TextBox2.Text = WorksheetFunction.Index(rLookup, nRow, nCol)
            
        End With
        
    End If

Exit Sub
Unknown:  'fout: lege textbox
TextBox2.Text = ""
'Deze Sub zorgt ervoor dat de From (Saturday) wordt ingevuld
End Sub

Private Sub FillInEnddate()
Dim rLookup As Range
Dim nRow As Long
Dim nCol As Long

    If DataPresent Then
        
        With Sheets("Weekends")
            'zoekgebied:
            [B][COLOR="#8b0000"]Set rLookup = .Range("b1", .Cells.SpecialCells(xlCellTypeLastCell))[/COLOR][/B]
            On Error GoTo Unknown:    'er treedt een fout op als er geen _
                                        waarden worden gevonden CellTypeLastCell)
            '   rij zoeken:
            nRow = rLookup.Columns(1).Find(ComboBox3.Value, _
                                            Lookat:=xlWhole, _
                                            LookIn:=xlValues, _
                                            MatchCase:=False).Row
            '   kolom zoeken:
            nCol = rLookup.Rows(2).Find("EndDate" & ComboBox2.Value, _
                                            Lookat:=xlWhole, _
                                            LookIn:=xlValues, _
                                            MatchCase:=False).Column - 1
            TextBox3.Text = WorksheetFunction.Index(rLookup, nRow, nCol)
            
        End With
        
    End If

Exit Sub
Unknown:  'fout: lege textbox
TextBox3.Text = ""
'Deze Sub zorgt ervoor dat de To (Friday) wordt ingevuld
End Sub

En:

Private Function DataPresent() As Boolean
    DataPresent = ComboBox2.Value <> Empty And _
                    ComboBox3.Value <> Empty
'Deze Function is nodig om een goede datum in te vullen voor de Subs FillInStartdate en FillInEnddate. Zonder deze Function
    'lukt dat niet
End Function

Als de gebruiker eenmaal alle gegevens ingevuld heeft kan de gebruiker ze via een CommandButton plaatsen in een ander tabblad. Bij het opslaan worden de gegevens automatisch gesorteerd op het personeelsnummer zodat alle personeelsleden bij elkaar komen te staan. Hiervoor gebruik ik de volgende code:

Private Sub CommandButton1_Click()    'Opslaan

    WelkBlad = Label1
    Sheets(WelkBlad).Select
    Set laatsteRij = ActiveSheet.Range("A65536").End(xlUp)

    laatsteRij.Offset(1, 0).Value = ComboBox2.Text
    laatsteRij.Offset(1, 1).Value = ComboBox3.Text
    laatsteRij.Offset(1, 2).Value = TextBox2.Text
    laatsteRij.Offset(1, 3).Value = TextBox3.Text
    laatsteRij.Offset(1, 4).Value = ComboBox1.Text
    laatsteRij.Offset(1, 5).Value = ComboBox4.Text
    laatsteRij.Offset(1, 6).Value = TextBox14.Text
    laatsteRij.Offset(1, 7).Value = ComboBox5.Text
    laatsteRij.Offset(1, 8).Value = TextBox15.Text
    laatsteRij.Offset(1, 9).Value = ComboBox6.Text
    laatsteRij.Offset(1, 10).Value = TextBox16.Text
    laatsteRij.Offset(1, 11).Value = ComboBox7.Text
    laatsteRij.Offset(1, 12).Value = TextBox17.Text
    laatsteRij.Offset(1, 13).Value = ComboBox8.Text
    laatsteRij.Offset(1, 14).Value = TextBox18.Text
    laatsteRij.Offset(1, 15).Value = ComboBox9.Text
    laatsteRij.Offset(1, 16).Value = TextBox19.Text
    laatsteRij.Offset(1, 17).Value = TextBox20.Text
    laatsteRij.Offset(1, 18).Value = TextBox6.Text
    Columns("B:AD").AutoFit
‘Rijen die opgeslagen worden

    [B][COLOR="#8b0000"]Range("A2:AC2000").Sort Key1:=Range("E2"), Order1:=xlAscending    [/COLOR][/B]
‘Sorteren

End Sub

Bij het opslaan geeft Excel een foutmelding (er wordt wel gesorteerd). Het gele gedeelte met SpecialCells is fout. Als ik echter het sorteer gedeelte (rood) weghaal werkt Excel wel goed. Het probleem is nu echter dat het niet gesorteerd wordt. Weten jullie hoe dit komt en hoe dit verbeterd kan worden?

Ik hoop dat deze informatie voldoende is. Als er meer nodig is, laat het maar horen. Het Excel bestand kan ik helaas niet posten...

Alvast bedankt voor jullie hulp,

EJProsman