habe hier zahlreiche hilfe bei folgendem sehr gut funktioniren dem Code bekommen
Option Compare Text
Private Sub cmdQuit_Click()
Unload Me
End Sub
Private Sub cmdSave_Click()
On Error Resume Next
Application.ScreenUpdating = False
Dim Name As String
Name = Bew_Dat.TextBox1.Value
If Name = "" Then
GoTo Ende
Else
Call TextBox1_AfterUpdate
End If
Ende:
sort1
Sheets("Übersicht").Select
Range("A1").Select
Application.ScreenUpdating = True
End Sub
Sub TextBox1_AfterUpdate()
Dim Bereich As String
Dim Name As String
Dim Vorname As String
Dim PS As String
Name = Bew_Dat.TextBox1.Value
Vorname = Bew_Dat.TextBox2.Value
PS = Bew_Dat.ComboBox2.Value
Bereich = Bew_Dat.ComboBox1.Value
Dim Letzte As Long, zeile As Long
Dim s As String, t As String, a As String
Dim b As Integer, zeile1 As Integer
s = Bew_Dat.TextBox1.Value
t = Bew_Dat.TextBox2.Value
If Sheets("Bew_Dat").Range("A65536").Value = "" Then
Letzte = Sheets("Bew_Dat").Range("A65536").End(xlUp).Row
Else
Letzte = 65536
End If
For zeile = Letzte To 1 Step -1
If Sheets("Bew_Dat").Cells(zeile, 1).Value = Bew_Dat.TextBox1.Value Then
If Sheets("Bew_Dat").Cells(zeile, 2).Value = Bew_Dat.TextBox2.Value Then
MsgBox (" Bewohner " & s & " " & t & " ist schon vorhanden")
Bew_Dat.TextBox1.Value = ""
Bew_Dat.TextBox2.Value = ""
Bew_Dat.ComboBox2.Value = ""
Bew_Dat.ComboBox1.Value = ""
Exit Sub
Else
a = 1
End If
Else
a = 1
End If
Next zeile
If a = 1 Then
Sheets("Bew_Dat").Range("A65536").End(xlUp).Offset(1, 0) = Name ' Hier die kannst du dann rausnehmen, wenn nicht unten oder
Sheets("Bew_Dat").Range("B65536").End(xlUp).Offset(1, 0) = Vorname ' den auch
Sheets("Bew_Dat").Range("C65536").End(xlUp).Offset(1, 0) = PS
Sheets("Bew_Dat").Range("D65536").End(xlUp).Offset(1, 0) = Bereich
b = Sheets("Bew_Dat").Range("A65536").End(xlUp).Offset(0, 0).Row
For zeile1 = b To 1 Step -1
If Sheets("Bew_Dat").Cells(zeile1, 1).Value "" And Sheets("Bew_Dat").Cells(zeile1, 2).Value = "" Then
Sheets("Bew_Dat").Cells(zeile1, 1).EntireRow.Delete
End If
Next zeile1
End If
End Sub
ich speicher mit dem code Daten in die Tabelle "Bew_Dat" fängt bei a1 an, nur muß ich zwecks filter die erste zeile als beschriftungszeile frei halten...hat jemand eine Idee?
Gruß HOLGI