Neue Zeile einfügen falls nach gesuchten Wert schon was in der Spalte steht.

[mig2881]

Hallo zusammen,

Ich habe mir eine UserFlorm erstellt mit mehreren Textboxen und ein Kalender.

In meinem Tabellenblat (Kalender) ist in A1 bis A400 das Datum eingetragen (01.01.2016 bis 31.12.2016)

Wenn ich bei der UserForm speichern drücke, möchte ich das er nach dem passendem Datum sucht und in der selben Spalte mir die Daten speichert die in den Textboxen geschrieben worden sind.

Falls unter dem Datum schon was in der Spalte steht soll er mir direkt darunte eine neue Spalte erzeugen.

Kann mir da bitte jemand Helfen?







Private Sub CommandButton1_Click()
    
    TextBox2 = ""
    TextBox3 = ""
    TextBox4 = ""
    TextBox5 = ""
    TextBox6 = ""
    TextBox7 = ""
    TextBox8 = ""
    TextBox9 = ""
    TextBox10 = ""
    TextBox11 = ""
    TextBox12 = ""
    
End Sub







Private Sub CommandButton2_Click()

 Dim rng As Range
 Dim lngZeile As Long
 
 'Spalte A na1ch Wert durchsuchen
 Set rng = Sheets("kalender").Range("A6:A500").Find(What:=Calendar1.Value, LookAt:=xlWhole, LookIn:=xlValues)
 'Datum gefunden
 If Not rng Is Nothing Then
     lngZeile = rng.Row
     ActiveSheet.Cells(lngZeile, 7).Value = TextBox2.Value
     ActiveSheet.Cells(lngZeile, 8).Value = TextBox3.Value
     ActiveSheet.Cells(lngZeile, 9).Value = TextBox4.Value
     MsgBox ("Daten übertragen")
   GoTo weiter
 Else
 MsgBox ("Datum nicht gefunden")
 End If
weiter:
 'Formular schließen
 Unload Me
 End Sub



Private Sub CommandButton3_Click()
    Unload Me
End Sub



Private Sub CommandButton4_Click()


 Sheets("AZB").Cells(2, 23) = TextBox2
 Sheets("AZB").Cells(12, 2) = TextBox9.Value
 Sheets("AZB").Cells(7, 1) = TextBox3 & TextBox4 & TextBox5.Value & TextBox6
 Sheets("AZB").Cells(12, 3) = TextBox10.Value
 Sheets("AZB").Cells(12, 4) = TextBox11.Value
 Sheets("AZB").Cells(12, 12) = TextBox7
 
Sheets("AZB").Copy
ActiveWorkbook.SaveAs Range("A12").Value & Range("A7") & ".xls"




End Sub

Private Sub Label14_Click()

End Sub

Private Sub TextBox10_Exit(ByVal Cancel As MSForms.ReturnBoolean)

TextBox11.Text = Format(CDate(TextBox10.Text) - CDate(TextBox9.Text), "hh:mm")

 
 If InStr(TextBox11, ":") > 0 Then
         If Mid(TextBox11.Text, InStr(TextBox11, ":") + 1) >= 15 Then
             TextBox12.Text = Mid(TextBox11.Text, 1, InStr(TextBox11, ":") - 1) + 1 & ":00"
         
         End If
     End If
 

End Sub





Private Sub UserForm_Initialize()
ComboBox1.RowSource = "Maske!A1:A4"
End Sub

[IchBinIch]

Hallo,

dann versuch es mal so:

Code:

Private Sub CommandButton2_Click()

Dim rng As Range
Dim lngZeile As Long

'Spalte A na1ch Wert durchsuchen
Set rng = Sheets("kalender").Range("A6:A500").Find(What:=Calendar1.Value, LookAt:=xlWhole, LookIn:=xlValues)
'Datum gefunden
If Not rng is Nothing And rng.Offset(,1) <> "" then
    rng.Offset(1,).EntireRow.Insert
End if

If Not rng Is Nothing And rng.Offset(,1) = ""Then
    lngZeile = rng.Row
    ActiveSheet.Cells(lngZeile, 7).Value = TextBox2.Value
    ActiveSheet.Cells(lngZeile, 8).Value = TextBox3.Value
    ActiveSheet.Cells(lngZeile, 9).Value = TextBox4.Value
    MsgBox ("Daten übertragen")
  GoTo weiter
Else
MsgBox ("Datum nicht gefunden")
End If
weiter:
'Formular schließen
Unload Me
End Sub

Gruß
Ich

[mig2881]

Hallo IchbinIch,
danke für deine Hilfe. Der Code hat soweit funkuniert

Ich habe nur ein Problem. Es wird eiene neue Zeile erzeugt aber leider überhalb der vorhandenen Zeile.
Die Zeile soll aber unterhalb erzeugt werden. Was habe ich falsch gemacht?

Danke 

Hier nochmal der Code:

Code:

Private Sub CommandButton2_Click()


Dim rng As Range
Dim lngZeile As Long


'Spalte A na1ch Wert durchsuchen
Set rng = Sheets("kalender").Range("A6:A500").Find(What:=Calendar1.Value, LookAt:=xlWhole, LookIn:=xlValues)
'Datum gefunden

 lngZeile = rng.Row
 
If Not rng Is Nothing And rng.Offset(, 7) <> "" Then
    rng.Offset(, 1).EntireRow.Insert
    ActiveSheet.Cells(lngZeile, 7).Value = TextBox2.Value
    ActiveSheet.Cells(lngZeile, 8).Value = TextBox3.Value
    ActiveSheet.Cells(lngZeile, 9).Value = TextBox4.Value
End If

If Not rng Is Nothing And rng.Offset(, 7) = "" Then
    lngZeile = rng.Row
    ActiveSheet.Cells(lngZeile, 7).Value = TextBox2.Value
    ActiveSheet.Cells(lngZeile, 8).Value = TextBox3.Value
    ActiveSheet.Cells(lngZeile, 9).Value = TextBox4.Value
    MsgBox ("Daten übertragen")
  GoTo weiter
Else
MsgBox ("Datum nicht gefunden")
End If
weiter:
'Formular schließen
Unload Me

[Kuwer]

Hallo,

Private Sub CommandButton2_Click()

Dim rng As Range

Dim lngZeile As Long



With Sheets("kalender")

 'Spalte A na1ch Wert durchsuchen

 Set rng = .Range("A6:A500").Find(What:=Calendar1.Value, LookAt:=xlWhole, LookIn:=xlValues)

 

 'Datum gefunden

 If Not rng Is Nothing Then

   lngZeile = rng.Row

   If rng.Offset(, 7).Value <> "" Then

     rng.Offset(1).EntireRow.Insert

     lngZeile = lngZeile + 1

   End If

   .Cells(lngZeile, 7).Value = TextBox2.Value

   .Cells(lngZeile, 8).Value = TextBox3.Value

   .Cells(lngZeile, 9).Value = TextBox4.Value

   MsgBox ("Daten übertragen")

 Else

   MsgBox ("Datum nicht gefunden")

 End If

End With

'Formular schließen

Unload Me

End Sub

Gruß Uwe