• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Sorteercode

Status
Niet open voor verdere reacties.
W

wieter

Terugkerende gebruiker
Lid geworden
26 jun 2009
Berichten
1.128
Via de ComboBox op de Uform van Blad1, kan je een nieuwe naam toevoegen aan de lijst op Blad2.
Daarna moeten de namen op Blad2 alfabetisch gerangschikt worden.
Daarvoor heb ik achter Blad2 de volgende code staan:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count <> 1 Then Exit Sub
  Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Sort Cells(2, 1), , , , , , , xlYes
End Sub
Die code achter Blad2 werkt.
Nu wil ik die sorteer-code rechtstreeks laten uitvoeren door Knop1 op de Uform(zie rode regel in onderstaande code)
Daardoor zou de code achter Blad2 weg kunnen.
Dit geeft echter een foutmelding.
Wat zou de oorzaak kunnen zijn?
Code: 
Private Sub CommandButton1_Click()
NieuweNaam = ComboBox1.Value
    Bestaatal = WorksheetFunction.CountIf(Sheets("Blad2").Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row), NieuweNaam) > 0
    If Bestaatal Then GoTo Hell
    LaatsteRij = Sheets("Blad2").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("Blad2").Cells(LaatsteRij + 1, "A") = ComboBox1.Value
    [COLOR="#FF0000"]Sheets("Blad2").Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Sort Cells(2, 1), , , , , , , xlYes[/COLOR]
Hell:
vVal = TextBox1
    bMatch = WorksheetFunction.CountIf(Range("A:A"), vVal) > 0
    If bMatch Then
    MsgBox ("Deze gegevens zijn reeds ingegeven, gebruik de knop" & vbNewLine & "[Wijzigen]" & _
    vbNewLine & "indien de gegevens moeten worden aangepast!" & vbNewLine & vbNewLine & "Of gebruik de knop [Reset]"), vbCritical, "Fout!"
    CommandButton2.SetFocus
    Exit Sub
    End If
Noot: Met de knop [Naar bestand] verdwijnt de Uform.
 

Bijlagen

  • Evaluatieformulier2.xlsm
    53,9 KB · Weergaven: 44
Ik heb het bestand niet bekeken, maar je verwijst naar je activesheet zonder de blauwe toevoegingen.

Code: 
Sheets("Blad2").Range("A2:A" & [COLOR=#0000ff]Sheets("Blad2").[/COLOR]Cells(Rows.Count, 1).End(xlUp).Row).Sort [COLOR=#0000ff]Sheets("Blad2").[/COLOR]Cells(2, 1), , , , , , , xlYes
 
Super Harry, ik dacht dat de eerste verwijzing(vooraan) voldoende was.
Niet dus.
Bedankt voor de oplossing.
Groeten Wieter
 
En dan nog wat:
Code: 
Private Sub UserForm_Initialize()
    TextBox1.Value = [max(Blad1!A:A)+1]
    TextBox3.Value = Format(Date, "dd-mm-yyyy")
    ComboBox1.List = Sheets(2).Cells(1).CurrentRegion.Offset(1).SpecialCells(2).Value

    With ListBox1
        .List = Blad1.Cells(1).CurrentRegion.Value
        .ColumnCount = UBound(.List, 2) - 1
        .ColumnWidths = "20;110;40" & Replace(Space(.ColumnCount - 3), " ", ";20")
    End With
End Sub
Code: 
Private Sub ListBox1_Click()
    With ListBox1
        If ListBox1.ListIndex > -1 Then
            For j = 1 To 48
               Me("CheckBox" & j) = .Column(j + 2)
            Next
        End If
        TextBox1 = .Column(0)
        ComboBox1 = .Column(1)
        TextBox3 = .Column(2)
        TextBox4 = .Column(51)
    End With
End Sub
 
Fijn van je SNB, dat je mijn amateur-code wat professioneler wil maken.
Bedankt!
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan