VBA ignoriert meinen Code

[Kaywarri124]

Und sowas zum Wochenende,

Guten Tag,

Ich weiß nicht was los ist, aber Excel Ignoriert die Speicher Baustein in meinem Code. Das hatte ich vorher mit der PW Abfrage und das Speichern ging, nun geht die PW Abfrage aber das speichern nicht mehr.
Ich verzweifel noch hier. Da es in der UF1 und UF2 nicht mehr geht und ich keine Ahnung haben warum, in einer anderen Tabelle geht es nach wie vor.

Code:

Private Sub CommandButton1_Click()
 
 
   'Passwortabfrage aus Tabbelle ("Passwörter")
   Zeile = 1
   gefunden = False
   txtsuche = ""
   Do While Worksheets("Passwörter").Cells(Zeile, 1) <> ""
       If Worksheets("Passwörter").Cells(Zeile, 2) = txt_passwort.Text Then
           txtsuche = Worksheets("Passwörter").Cells(Zeile, 1)
           gefunden = True
       End If
   Zeile = Zeile + 1
   Loop
   If gefunden Then
       Zeile = 2
       Do While Worksheets("protokoll").Cells(Zeile, 1) <> ""
       Zeile = Zeile + 1
       Loop
       Worksheets("protokoll").Cells(Zeile, 1) = txt_nachname
       Worksheets("protokoll").Cells(Zeile, 2) = Now()
  Dim lZeile As Long
 
    'Wenn kein Datensatz in der ListBox1 markiert wurde, wird die Routine beendet
    If ListBox1.ListIndex = -1 Then Exit Sub
   
    'Ich muss prüfen, ob die ID Spalte auch gefüllt ist!!
    If Trim(CStr(txt_nachname.Text)) = "" Then
        'Meldung ausgeben
        MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!"
        'Abbrechen der Speicherroutine
        Exit Sub
    End If
     

'AB HIER FÄNGT ER AN DEN TEIL ZU ÜBERSPRIGEN
-------------------------------------------------------------------------------------------------------------   
    'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
    lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
    'Schleife solange etwas in der zweiten Spalte in Tabelle 1 drin steht
    Do While Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) <> ""
     
   
        'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
        If ListBox1.Text = Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) Then
           
            'Eintrag gefunden, TextBoxen in die Zellen schreiben
           
            Worksheets("usernamen").Cells(lZeile, 2).Value = Trim(CStr(txt_nachname.Text))
            Worksheets("usernamen").Cells(lZeile, 3).Value = Trim(CStr(txt_vorname.Text))
            Worksheets("usernamen").Cells(lZeile, 4).Value = txt_DG.Text
            Worksheets("usernamen").Cells(lZeile, 5).Value = txt_datum.Text
           
'UND AB HIER STEIGT ER WIEDER EIN
------------------------------------------------------------------------------------------------------------                       
             'Die ListBox muss nun neu geladen werden
            'allerdings nur, wenn sich der txt_Nachname (ID) geändert hat
            If ListBox1.Text <> Trim(CStr(txt_nachname.Text)) Then
               
                If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
            End If
           
            Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
           
        End If
   
        lZeile = lZeile + 1 'Nächste Zeile bearbeiten

       
    Loop
   Else
   MsgBox "Falsches PW"
   End If
       
End Sub

[RPP63]

Moin!
Vielleicht solltest Du die Datei noch kurz vor dem Wochenende hochladen.
Natürlich anonymisiert und ungeschützt.
By the way:
Dein Code ist mit den Do While-Schleifen etwas anachronistisch, hat aber nix mit Deinem Problem zu tun.

Gruß Ralf

[Storax]

By the way:
Dein Code ist mit den Do While-Schleifen etwas anachronistisch, hat aber nix mit Deinem Problem zu tun.

Warum ist Do-While (genauer Do Loop) anachronistisch, oder meinst Du, wie das hier angewendet wird?
Do-While Syntax ist doch korrekt eingehalten und wird aktuell so verwendet

Code:

Do { While | Until } condition  
   [ statements ]  
   [ Continue Do ]  
   [ statements ]  
   [ Exit Do ]  
   [ statements ]  
Loop  
-or-  
Do  
   [ statements ]  
   [ Continue Do ]  
   [ statements ]  
   [ Exit Do ]  
   [ statements ]  
Loop { While | Until } condition  

Ich würde eher While Wend als anachronistisch bezeichnen

[RPP63]

So etwas matche ich, ganz ohne Schleife, Storax.
Ich schrieb auch nur von einem Anachronismus, nicht von einem Fehler.

[Kaywarri124]

Danke für die schnellen Antworten,

ich bin kein Fachmann, weiß nur das, was ich aus copy paste haben und mir dadurch einiges an Wissen in den letzten Monaten zusammen getragen habe.
Daher keine Ahnung was ihr meint XD Sorry :D:D

Aber das mit dem Hochladen wird schwer. Es sind einige Verknüpfungen drin und da es eine Eingabemaske mit Benutzerprofilen sein soll, sind allerlei Passwörter schon eingefügt die alle raus zunehmen würde lange dauern.

Grundsätzlich speichert auch auch, was er nicht tut ist die Termin Eingabe.

txt_Nachname
txt_Vorname
txt_Dg

wird gespeichert ( btw soll es gar nicht daher haben ich es auch gelöscht, da diese Infos über eine Verlinkung kommt )

aber

Txt_Termin ( alter code txt_Datum ) wird beim drücken auf Com 1 gelöscht und verschwindet im Nirvana. Die userform will das Datum einfach nicht speichern.

Das ist der komplette Code zu UserForm1 ( ich habe paar wirklich uninteressante Dinge gelöscht )

Code:

Private Sub com_speichern_Click()
 
 
   'Passwortabfrage aus Tabbelle ("Passwörter")
   Zeile = 1
   gefunden = False
   txtsuche = ""
   Do While Worksheets("Passwörter").Cells(Zeile, 1) <> ""
       If Worksheets("Passwörter").Cells(Zeile, 2) = txt_Passwort.Text Then
           txtsuche = Worksheets("Passwörter").Cells(Zeile, 1)
           gefunden = True
       End If
   Zeile = Zeile + 1
   Loop
   If gefunden Then
       Zeile = 2
       Do While Worksheets("protokoll").Cells(Zeile, 1) <> ""
       Zeile = Zeile + 1
       Loop
       Worksheets("protokoll").Cells(Zeile, 1) = txt_Nachname
       Worksheets("protokoll").Cells(Zeile, 2) = Now()
  Dim lZeile As Long
 
    'Wenn kein Datensatz in der ListBox1 markiert wurde, wird die Routine beendet
    If ListBox1.ListIndex = -1 Then Exit Sub
   
    'Ich muss prüfen, ob die ID Spalte auch gefüllt ist!!
    If Trim(CStr(txt_Nachname.Text)) = "" Then
        'Meldung ausgeben
        MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!"
        'Abbrechen der Speicherroutine
        Exit Sub
    End If
    'Ausbauoption: Prüfen, ob die ID in Tabelle1 Spalte 1 schon vorhanden ist!
   
    'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
    lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
    'Schleife solange etwas in der zweiten Spalte in Tabelle 1 drin steht
    Do While Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) <> ""
     
   
        'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
        If ListBox1.Text = Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) Then
           
            'Eintrag gefunden, TextBoxen in die Zellen schreiben
           
            Worksheets("usernamen").Cells(lZeile, 5).Value = txt_termin.Text
           
                       
            'Die ListBox muss nun neu geladen werden
            'allerdings nur, wenn sich der txt_Nachname (ID) geändert hat
            If ListBox1.Text <> Trim(CStr(txt_Nachname.Text)) Then
               
                If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
            End If
           
            Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
           
        End If
   
        lZeile = lZeile + 1 'Nächste Zeile bearbeiten

       
    Loop
   Else
   MsgBox "Falsches PW"
   End If
       
End Sub
_________________________________________________________________________________________________________________
Private Sub ListBox1_Click()
  Dim lZeile As Long
    'Wenn der Benutzer einen Namen anklickt, suchen wir
    'diesen in der Tabelle1 heraus und tragen die Daten
    'in die TextBoxen ein.
   
    'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
    txt_Nachname = ""
    txt_Vorname = ""
    txt_DG = ""
    txt_termin = ""

   
    'Nur wenn ein Eintrag selektiert/markiert ist
    If ListBox1.ListIndex >= 0 Then
   
        lZeile = 2 'Start in Zeile 7, Zeile 6 sind ja die Überschriften
        'Schleife solange etwas in der zweiten Spalte in Tabelle 1 drin steht
        Do While Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) <> ""
         
       
            'Wenn wir den Namen aus der ListBox1 in der Tabelle1 Spalte 2
            'gefunden haben, übertragen wir die anderen Spalteninhalte
            'in die TextBoxen!
            If ListBox1.Text = Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) Then
             
           
                'TextBoxen füllen
                txt_Nachname = ListBox1.List(ListBox1.ListIndex, 0)
                txt_Vorname = ListBox1.List(ListBox1.ListIndex, 1)
                txt_DG = Worksheets("usernamen").Cells(lZeile, 4).Value
                txt_termin = Worksheets("usernamen").Cells(lZeile, 5).Value
               
               
                Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
           
            End If
       
            lZeile = lZeile + 1 'Nächste Zeile bearbeiten
       
        Loop
       
    End If
End Sub

_________________________________________________________________________________________________________________
Private Sub txt_termin_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(Me.txt_termin) Then
       Me.txt_termin = Format(Me.txt_termin, "MM DD YYYY")
   ElseIf Me.txt_termin <> vbNullString Then
       Beep
       Cancel = True

   End If
End Sub

_________________________________________________________________________________________________________________

Private Sub txtSuche_Change()
 Dim i As Integer, ii As Integer
 Dim vntList, strTxt As String, arrSelected()
 strTxt = LCase(txtsuche)
 vntList = ListBox1.List
 ReDim arrSelected(ListBox1.ListCount - 1)
 For i = 0 To ListBox1.ListCount - 1
   For ii = 0 To ListBox1.ColumnCount - 1
     arrSelected(i) = InStr(LCase(vntList(i, ii)), strTxt) > 0
     If arrSelected(i) Then Exit For
   Next
 Next
 With ListBox1
 For i = 0 To .ListCount - 1
   .Selected(i) = arrSelected(i)
 Next
 End With
End Sub

_________________________________________________________________________________________________________________
Private Sub UserForm_Initialize()
      Dim lZeile As Long
     
      'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
    txt_Nachname = ""
    txt_Vorname = ""
    txt_DG = ""
    txt_termin = ""

    'In dieser Routine laden wir alle vorhandenen
    'Einträge in die ListBox1
    ListBox1.Clear 'Zuerst einmal die Liste leeren
   
    lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
    'Schleife solange etwas in der zweiten Spalte in Tabelle 1 drin steht
    Do While Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) <> ""

 
       
        'Aktuelle Zeile in die ListBox eintragen
        ListBox1.AddItem
           ListBox1.List(ListBox1.ListCount - 1, 0) = Worksheets("usernamen").Cells(lZeile, 2).Text
           ListBox1.List(ListBox1.ListCount - 1, 1) = Worksheets("usernamen").Cells(lZeile, 3).Text
           
           
        lZeile = lZeile + 1 'Nächste Zeile bearbeiten
       
    Loop
     
End Sub
_________________________________________________________________________________________________________________

[Storax]

So etwas matche ich, ganz ohne Schleife, Storax.
Ich schrieb auch nur von einem Anachronismus, nicht von einem Fehler.

Klar, da hast Du Recht, man braucht keine Schleife.
Dann hatte ich das mißverstanden.

[Steffl]

Hallo,

Grundsätzlich speichert auch auch, was er nicht tut ist die Termin Eingabe.

txt_Nachname
txt_Vorname
txt_Dg

wird gespeichert ( btw soll es gar nicht daher haben ich es auch gelöscht, da diese Infos über eine Verlinkung kommt )

aber

Txt_Termin ( alter code txt_Datum ) wird beim drücken auf Com 1 gelöscht und verschwindet im Nirvana. Die userform will das Datum einfach nicht speichern.

Setze vor einer Codezeile mit txt_termin einen Haltepunkt.

[Kaywarri124]

Guten Tag, Allen einen guten Start in die Woche.

Danke für die Antworten.

Ich habe das mit den Haltepunkten gemacht und habe gesehen das txt_Termin immer "" ist.

Naja ich habe mal die PW Abfrage ausgeklammert und siehe da, es liegt an der PW Abfrage.

Code:

  Zeile = 1
   gefunden = False
   txtsuche = ""
   Do While Worksheets("Passwörter").Cells(Zeile, 1) <> ""
       If Worksheets("Passwörter").Cells(Zeile, 2) = txt_Passwort.Text Then
           txtsuche = Worksheets("Passwörter").Cells(Zeile, 1)
           gefunden = True
       End If
   Zeile = Zeile + 1
   Loop
   If gefunden Then
       Zeile = 2
       Do While Worksheets("protokoll").Cells(Zeile, 1) <> ""
       Zeile = Zeile + 1
       Loop
       Worksheets("protokoll").Cells(Zeile, 1) = txt_Nachname
       Worksheets("protokoll").Cells(Zeile, 2) = Now()

'hier kommt  dann der Speicher Code

[Kaywarri124]

Danke nochmal, echt immer wieder gute Hilfe,

habe das Problem gelöst.

Er fragt nach Benutzername und Passwort und speichert dann die Eingabe

Code:

  'Passwortabfrage aus Tabbelle ("Passwörter")
   zeile = 2
   gefunden = False
   Do While Worksheets("Passwörter").Cells(zeile, 1) <> ""
       If Worksheets("Passwörter").Cells(zeile, 1) = txtsuche.Text Then
           If Worksheets("Passwörter").Cells(zeile, 2) = txt_Passwort.Text Then
               gefunden = True
           End If
       End If
   zeile = zeile + 1
   Loop
   If gefunden Then
       zeile = 2
       Do While Worksheets("protokoll").Cells(zeile, 1) <> ""
       zeile = zeile + 1
       Loop
       Worksheets("protokoll").Cells(zeile, 1) = txt_Nachname
       Worksheets("protokoll").Cells(zeile, 2) = Now()
  Dim lZeile As Long

    'Wenn kein Datensatz in der ListBox1 markiert wurde, wird die Routine beendet
    If ListBox1.ListIndex = -1 Then Exit Sub
   
    'Ich muss prüfen, ob die ID Spalte auch gefüllt ist!!
    If Trim(CStr(txt_Nachname.Text)) = "" Then
        'Meldung ausgeben
        MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!"
        'Abbrechen der Speicherroutine
        Exit Sub
    End If
    'Ausbauoption: Prüfen, ob die ID in Tabelle1 Spalte 1 schon vorhanden ist!
   
    'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
    lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
    'Schleife solange etwas in der zweiten Spalte in Tabelle 1 drin steht
    Do While Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) <> ""
     
   
        'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
        If ListBox1.Text = Trim(CStr(Worksheets("usernamen").Cells(lZeile, 2).Value)) Then
           
            'Eintrag gefunden, TextBoxen in die Zellen schreiben
           
           
            Worksheets("usernamen").Cells(lZeile, 5).Value = txt_termin.Text
           
                       
            'Die ListBox muss nun neu geladen werden
            'allerdings nur, wenn sich der txt_Nachname (ID) geändert hat
            If ListBox1.Text <> Trim(CStr(txt_Nachname.Text)) Then
               
                If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
            End If
           
            Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
           
        End If
   
        lZeile = lZeile + 1 'Nächste Zeile bearbeiten

       
    Loop
   Else
   MsgBox "Keine Übereinstimmung Nachname mit Passwort. Bitte wiederholen sie ihre Eingabe. Wenn sie noch kein Passwort haben gehen sie auf Passwort Anfrage melden sie sich beim Admin unter App.: 6513"
   End If
       
End Sub