VBA code stopt ergens, maar waar ???

[hoogteijling]

Hallo allemaal,

In bijgevoegd excel bestand is het de bedoeling dat er een project toegevoegd wordt en dat het vervolgens op kolom C gesorteerd wordt.
Dit werkt alleen vult ie alleen de datum+projectnummer in, de andere gegevens zie ik niet terugkomen.
Weet iemand hoe ik kan zorgen dat het wel goed gaat en ik dus gewoon alle ingevulde gegevens terug zie in het blad ?

Wanner je dus bijv. projectnummer 1235-0B toevoegt zou die tussengevoegd moeten worden tussen 1235-0A en 1235-0C.

Zie ook:
http://office.webforums.nl/viewtopic.php?f=26&t=47459

Groeten Marcel
Bekijk bijlage Projectenboek uitgekleed.zip

 

[popipipo]

Zet de sorteerfunctie niet een apart 'worksheet event' maar zet deze achteraan de invoer van de userform

 

[hoogteijling]

Dank voor je reactie Popipipo.
Wanneer ik doe wat je zegt wordt mijn blad niet meer (automatisch) gesorteerd.

Groeten Marcel

 

[popipipo]

Hier mijn bestandje met een iets aangepast sorteer module waarbij het wel werkt

 

[hoogteijling]

Dank je popipipo,
eindelijk werkt het nu zoals het hoort.
Ik had geen idee dat het probleem in het sorteer gedeelte zat.

Is er ook nog een mogelijkheid om te voorkomen dat er een projectnummer ingevoerd wordt wat al bestaat ?

Groeten Marcel

 

[Warme bakkertje]

Private Sub CommandButton3_Click()                                                      '<= Project toevoegen button in Uform
  Dim oRng As Range
    Application.ScreenUpdating = False
    PrjctNr = IIf(Len(TextBox2.Value) = 4, Format(TextBox2.Value, "@.@@@") & "-" & ComboBox11.Value & ComboBox12.Value, _
                    Format(TextBox2.Value, "@.@.@@@") & "-" & ComboBox11.Value & ComboBox12.Value)
    With Sheets("Projectenboek")
        For Each cl In .Range("C2:C" & .Cells(Rows.Count, 3).End(xlUp).Row)
            sq = sq & cl.Value & " "
        Next
        If InStr(1, sq, PrjctNr) <> 0 Then MsgBox "Projectnummer bestaat reeds !!": Exit Sub
        rij = .Range("C" & Rows.Count).End(xlUp).Row + 1                                '<= Eerstvolgende lege regel (in kolom C)
        .Cells(rij, "B") = DateValue(Format(DTPicker1.Value, "dd-mm-yyyy"))             '<= Datum plaatsen
        .Cells(rij, "C") = PrjctNr                                                      '<= zorgt voor correcte notatie projectnummer (puntjes)
        .Cells(rij, "D") = ComboBox13.Value                                             '<= Status plaatsen
        .Cells(rij, "E") = TextBox3.Value                                               '<= Omschrijving plaatsen
        .Cells(rij, "F") = IIf(CheckBox21, "Regie", TextBox4.Value)
        .Cells(rij, "G") = TextBox5.Value                                               '<= Aanvrager plaatsen
        .Cells(rij, "H") = TextBox6.Value                                               '<= Actie plaatsen
        .Cells(rij, "I") = TextBox7.Value                                               '<= Opmerking plaatsen
        On Error GoTo 0
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("C1:C" & .Cells(Rows.Count, 3) _
                    .End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending
        With .Sort
            .SetRange Range("B1:J" & Sheets("Projectenboek") _
                        .Cells(Rows.Count, 2).End(xlUp).Row)
            .Header = xlYes
            .Apply
        End With
    End With
    proj_toev.Hide
    Unload Me
    Application.ScreenUpdating = True
End Sub

PS: Pas de tabindexen van je objecten in je Uform aan zodat je chronologisch door je form navigeert en niet willekeurig over je form.

 

[hoogteijling]

Fantastisch, bedankt Warm bakkertje !!!

Kan iemand me ook nog verder helpen om de knop "Project verwijderen" werkend te krijgen ?
Uiteraard moet de lijst dan weer netjes gesorteerd blijven en er mag geen lege regel achterblijven.
Ook eventueel een melding als het te verwijderen projectnummer niet bestaat.
Wat ik helemaal mooi zou vinden is wanneer er een melding verschijnt of je zeker weet dat je het project wilt verwijderen.

Groeten Marcel

 

[hoogteijling]

Hierbij de nieuwste bijlage

Groeten Marcel
Bekijk bijlage Projectenboek.zip

 

[snb]

waarom niet gewoon gesorteerd met

sheets(1).cells(1).currentregion.offset(,1).sort sheets(1).cells(1,3)

 

[Warme bakkertje]

Waarom niet enkel 1 CB op je verwijderenfrom waarin je alle gebruikte projectnummers ophaalt ?
Hierdoor wordt de controle op een al of niet bestaand projectnummer irrelevant.

Ps de code in je nieuwe bijlage is niet correct overgenomen uit mijn post en zal derhalve niet werken !!!!

 

[hoogteijling]

@Warme bakkertje:
Ik zie idd dat ik op meerdere plaatsen code moet invoegen.
(toen ik het testte werkte het trouwens wel hoor, maar dat zal wel niet in alle situaties zijn)
Ik zal het morgen aanpassen.

Ik begrijp wat je bedoelt, je stelt voor om in een CB de al bestaande projectnummers tevoorschijn te laten komen.
Ik heb helaas geen flauw idee hoe ik dit voor elkaar moet krijgen.

@snb:
Dank je voor de toevoeging.
Ik heb geen flauw idee waar ik jouw regeltje code moet plakken en of er nog iets voor moet staan.
Ik weet vrijwel niets van VBA.

Groeten Marcel

 

[snb]

Dan zou ik daar maar eerst eens mee beginnen.

 

[Warme bakkertje]

In je Verwijderenform met 1 combobox.

Private Sub UserForm_Initialize()
    With Sheets("Projectenboek")
        sq = .Range("C2:C" & .Cells(Rows.Count, 3).End(xlUp).Row)
    End With
    ComboBox1.List = sq
End Sub

Private Sub ComboBox1_Change()
    CommandButton3.Visible = ComboBox1.Value <> vbNullString
End Sub

Private Sub CommandButton3_Click() '<= Project verwijderen button in Uform
    If MsgBox("Project definitief verwijderen ??", vbQuestion + vbOKCancel, "Project verwijderen") = vbOK Then
        Application.ScreenUpdating = False
        With Sheets("Projectenboek")
            .Cells(.Columns(3).Find(ComboBox1.Value, , xlValues, xlWhole).Row, 3).[COLOR="#FF0000"]Offset(,-1)[/COLOR].Resize(, 9).ClearContents
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=Range("C1:C" & .Cells(Rows.Count, 3) _
                    .End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending
            With .Sort
                .SetRange Range("B1:J" & Sheets("Projectenboek") _
                        .Cells(Rows.Count, 2).End(xlUp).Row)
                .Header = xlYes
                .Apply
            End With
        End With
    Else
    End If
    proj_verw.Hide
    Unload Me
    Application.ScreenUpdating = True
End Sub

 

[DZP]

Rudi,
Als ik vragen mag => waar staat die Resize (, 9) voor?
B.v.d. Henk

 

[Cobbe]

Als je de term 'Resize' in je VBE intikt en dan drukt op F1, krijg je een uitleg die niemand je hier kan geven.

 

[hoogteijling]

@Warme bakkertje,

-1- Wanneer ik een project verwijder laat ie de datum nog staan
-2- Kun je in de bijgevoegde bijlage de code mbt het sorteren goed zetten voor mij of de complete code hier posten ?
-3- Wanneer ik nu een project toevoeg zegt ie steeds dat het projectnummer al bestaat

Groeten Marcel
Bekijk bijlage Projectenboek.zip

 

[Warme bakkertje]

@ DZP

.Cells(.Columns(3).Find(ComboBox1.Value, , xlValues, xlWhole).Row, 3)

Hiermee vind je de cel in kolom 3 waarin het projectnummer staat.
Met Resize ga je dit uitbreiden tot de gewenste range dus Resize(aantal rijen,aantal kolommen) waarop je dan weer verdere acties kan uitvoeren.
Wil je bv Range("A12") van Blad1 kopieëren naar de eerstvolgende lege regel op blad2 kan je schrijven

Sheets("Blad2").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(2,5) = Sheets("Blad1").Range("A1:D2").Value

 

[Warme bakkertje]

Datumprobleem aangepast in vorige post (zie rode aanpassing)
Bijlage ?

 

[hoogteijling]

Ik heb de bijlage inmiddels toegevoegd aan mijn post#16

groeten Marcel

 

[Warme bakkertje]

Zie bijlage.
Ik had je reeds gewaarschuwd voor het niet correct overnemen v/d code nietwaar ?