Fehlerhafter Code??

[Klaus]

Hallo miteinander,

ich habe in einer Datei, mit welcher man über eine UF eine Liste bearbeiten (löschen / hinzufügen / sortieren) kann einen Code, welcher Begriffe zu der Liste hinzu fügt. 
Wenn ich diesen Code verwende, dann kommt es in seltenen Fällen vor, dass die dazugehörige Datei schlagartig geschlossen wird.

Leider habe ich nicht die Ahnung und würde mich freuen, wenn jemand mal einen Blick drauf wirft, ob der Code fehlerhaft ist und dies zum Schließen / Absturz der Datei führen könnte.

Code:

Option Explicit

Private rngUberschriften As Range

Private Sub cmdHinzufügen_Click()
   Dim strEingabe As String
   Dim lngLetzteZeile  As Long
   Dim rngVorhanden As Range
   'eine Inputbox für die Neuaufnahme eines Produktes
   strEingabe = InputBox("Geben Sie ein Produkt ein", "Neueingabe")
   'wenn in der Inputbox nichts eingetragen, abbrechen gedrückt oder die ComboBox nichts enthält verlasse die Sub
   If strEingabe = "" Or ComboBox1.ListIndex = -1 Then Exit Sub
   With Worksheets("Tabelle1")
      Set rngVorhanden = .Columns(rngUberschriften.Column).Find(strEingabe, LookIn:=xlValues, lookat:=xlWhole)
      If Not rngVorhanden Is Nothing Then Exit Sub
      'erste leere Zelle in der betreffenden Spalte suchen
      lngLetzteZeile = .Cells(.Rows.Count, rngUberschriften.Column).End(xlUp).Row + 1
      'wert eintragen
      .Cells(lngLetzteZeile, rngUberschriften.Column).Value = strEingabe
      'und sotrieren
      .Columns(rngUberschriften.Column).Sort key1:=.Cells(1, rngUberschriften.Column), order1:=xlAscending, Header:=xlYes
   End With

End Sub

Anbei die dazugehörige Datei.

Vielen Dank schon mal  :)
Liebe Grüße
Klaus

[atilla]

Hallo,

im Code ist kein Fehler zu erkennen.

Besser wäre aber den Code nicht mit Exit Sub abzuwürgen, wenn möglich.
So würde ich es dann aussehen.

Code:

Private Sub cmdHinzufügen_Click()
   Dim strEingabe As String
   Dim lngLetzteZeile  As Long
   Dim rngVorhanden As Range
   'eine Inputbox für die Neuaufnahme eines Produktes
   strEingabe = InputBox("Geben Sie ein Produkt ein", "Neueingabe")
   'wenn in der Inputbox nichts eingetragen, abbrechen gedrückt oder die ComboBox nichts enthält verlasse die Sub
   If strEingabe <> "" And ComboBox1.ListIndex > -1 Then
      With Worksheets("Tabelle1")
         Set rngVorhanden = .Columns(rngUberschriften.Column).Find(strEingabe, LookIn:=xlValues, lookat:=xlWhole)
         If Not rngVorhanden Is Nothing Then Exit Sub
         'erste leere Zelle in der betreffenden Spalte suchen
         lngLetzteZeile = .Cells(.Rows.Count, rngUberschriften.Column).End(xlUp).Row + 1
         'wert eintragen
         .Cells(lngLetzteZeile, rngUberschriften.Column).Value = strEingabe
         'und sotrieren
         .Columns(rngUberschriften.Column).Sort key1:=.Cells(1, rngUberschriften.Column), order1:=xlAscending, Header:=xlYes
      End With
   End If

End Sub

Ich habe die If Abfrage umgedreht, so dass der Code abgearbeitet wird wenn die Bedingungen zutreffen.

Hast Du vielleicht Indirekt() Formeln in Deiner Datei?

[Kuwer]

Hallo Klaus,

ich sehe im Code auch nichts Verdächtiges. Aber was Du machen könntest, ist das Umstellen der TakeFocusOnClick-Eigenschaft des CommandButtons im Blatt auf False. Siehe dazu auch hier:  Befehlsschaltfläche (CommandButton) - Probleme im Tabellenblatt

@Atilla
Ein Exit Sub ist noch drin.

Gruß Uwe

[snb]

Meinen Vorschlag:

[atilla]

Hallo Klaus,

Uwe hat es schon geschrieben, in meinem Vorschlag gibt es noch ein Exit Sub, was ich ja gar nicht drin haben wollte.
Deswegen hier noch mal der Korrigierte Vorschlag:

Code:

Private Sub cmdHinzufügen_Click()
   Dim strEingabe As String
   Dim lngLetzteZeile  As Long
   Dim rngVorhanden As Range
   'eine Inputbox für die Neuaufnahme eines Produktes
   strEingabe = InputBox("Geben Sie ein Produkt ein", "Neueingabe")
   'wenn in der Inputbox nichts eingetragen, abbrechen gedrückt oder die ComboBox nichts enthält verlasse die Sub
   If strEingabe <> "" And ComboBox1.ListIndex > -1 Then
      With Worksheets("Tabelle1")
         Set rngVorhanden = .Columns(rngUberschriften.Column).Find(strEingabe, LookIn:=xlValues, lookat:=xlWhole)
         If rngVorhanden Is Nothing Then
         'erste leere Zelle in der betreffenden Spalte suchen
         lngLetzteZeile = .Cells(.Rows.Count, rngUberschriften.Column).End(xlUp).Row + 1
         'wert eintragen
         .Cells(lngLetzteZeile, rngUberschriften.Column).Value = strEingabe
         'und sotrieren
         .Columns(rngUberschriften.Column).Sort key1:=.Cells(1, rngUberschriften.Column), order1:=xlAscending, Header:=xlYes
         Else
            MsgBox "Diese(s) " & ComboBox1 & " existiert bereits!"
         End If
      End With
End If

End Sub

@snb
es fehlt noch die Sortierung nach Übertragung.
Wäre schön, wenn Du dafür den Code auch noch lieferst.

@Uwe

peinlich aber war.
Sollte jetzt kein "Fehlerhafter Code" mehr sein. :20:

[Kuwer]

Hallo Atilla,

... hier noch mal der Korrigierte Vorschlag:

nun ist wieder das andere drin! :19:

Gruß Uwe

[snb]

@Attila

Ich liefere hier keine 'turn-key' Lösungen, nur Vorschläge womit man weiter arbeiten/experimentieren kann.

[Klaus]

Wowwww.... Ich bin ja mal wieder geplättet.

Vielen herzlichen Dank Euch für das Checken des Codes und die Korrektur- / Veränderungsvorschläge.
Ihr seid echt Spitze.

@Attila - darauf muss man ja erstmal kommen das umzudrehen  :19: 
Nehm ich gern an.
Eine Indirekt() Formel ist nicht verwendet. Ich hab bei diesem Projekt weitestgehend alles auf VBA umgestellt. Ein paar S-Verweise sind noch enthalten.

@Kuwer - Vielen Dank für den Hinweis und den Link - ich werde das entsprechend richtig stellen.

@snb - Vielen Dank für die Umstellung der Datei. Ist wieder einiges bei was ich erstmal ergründen muss   :75:  

Liebe Grüße
Klaus

[Klaus]

@ snb - warum gibt es auf deiner Webseite eigentlich keine Suchfunktion?
Ich wollte mich gerade zu "CurrentRegion" etwas belesen... scheitere aber am Index.

Versuche gerade hinter die zweite Zeile deines Codes:

Code:

ComboBox1.List = Application.Transpose(Sheets("Tabelle1").Cells(1).CurrentRegion.Value)

und warum dort dies in Verbindung mit "Application.Transpose" Verwendung findet zu steigen...

[snb]

Deine VBEditor (Alt-F11) hat ein F1 Taste.
Dort findest du alles was 'currentregion' bedeutet; das kann ich nicht verbessern.

Was ich meine mit 'experimentieren:
Fang mal an mit:

Code:

ComboBox1.List = sheets("Tabelle1").Cells(1).CurrentRegion.Value
msgbox ubound(combobox1.List) & vblf & ubound(combobox1.list,2)
combobox1.column.count=ubound(combobox1.list,2)+1

' ComboBox1.List = Application.Transpose(Sheets("Tabelle1").Cells(1).CurrentRegion.Value)
' msgbox ubound(combobox1.List) & vblf & ubound(combobox1.list,2)
' combobox1.column.count=ubound(combobox1.list,2)+1