Search code examples
excelvbaselecttextboxfind

VBA Find Date via Textbox


I have a simple excel list so that I can keep track of the checks I have written in the company.

Check List

Userform Image

When entering data to my list; If the check due date I entered in the Textbox on the Userform and the check due date previously written on the last line in my excel list are the same, I can enter the check details at the end of the list with the code below.

If the check due date entered in the Textbox on the Userform and the check due date previously written on the last line in my excel list are not the same; I want to add the due date I entered in the textbox to the list by finding it in the list.

The date I entered the textbox may not be on my list at all. At that time, the date will need to find between which two dates the data should be entered and add a line there.

Unfortunately I haven't been able to do that yet.

I tried below code :

`

        Son_Dolu_Satir = Sheets("Çek Programı").Range("C60").End(xlUp).Row
        Bos_Satir = Son_Dolu_Satir + 1

    If TextBox3.Text = Sheets("Çek Programı").Range("C60").End(xlUp).Value Then

        Sheets("Çek Programı").Range("E" & Bos_Satir).Value = TextBox1.Text
        Sheets("Çek Programı").Range("H" & Bos_Satir).Value = ComboBox1.Text
        Sheets("Çek Programı").Range("F" & Bos_Satir).Value = TextBox2.Text
        Sheets("Çek Programı").Range("C" & Bos_Satir).Value = TextBox3.Text
        Sheets("Çek Programı").Range("J" & Bos_Satir).Value = TextBox6.Text

    ElseIf TextBox3.Text <> Sheets("Çek Programı").Range("C60").End(xlUp).Value Then

        Sheets("Çek Programı").Range("C60").End(xlUp).End(xlUp).Row
        Sheets("Çek Programı").Range("E" & Bos_Satir).Value = TextBox1.Text
        Sheets("Çek Programı").Range("H" & Bos_Satir).Value = ComboBox1.Text
        Sheets("Çek Programı").Range("F" & Bos_Satir).Value = TextBox2.Text
        Sheets("Çek Programı").Range("C" & Bos_Satir).Value = TextBox3.Text
        Sheets("Çek Programı").Range("J" & Bos_Satir).Value = TextBox6.Text

    Else

    End If

Solution

  • Scan up the sheet comparing dates to find the insert position.

    Option Explicit
    Private Sub CommandButton1_Click()
    
        Const COL_DATE = "C"
    
        Dim wb As Workbook, ws As Worksheet
        Dim Son_Dolu_Satir As Long, r As Long
        Dim dt As Date, dtDue As Date, s As String
        Dim dtFirst As Date, dtLast As Date, num As String
        
        ' check valid date
        s = TextBox3.Text
        If IsDate(s) Then
           dtDue = CDate(s)
        Else
           MsgBox s & " is not a valid date", vbCritical
           Exit Sub
        End If
        
        Set wb = ThisWorkbook
        Set ws = wb.Sheets("Çek Programi")
        
        ' check if number is existing
        num = TextBox2.Text
        If WorksheetFunction.CountIf(ws.Range("F:F"), num) > 0 Then
           MsgBox num & " is an existing check number", vbCritical
           Exit Sub
        End If
        
        ' find row
        With ws
            Son_Dolu_Satir = .Cells(.Rows.Count, COL_DATE).End(xlUp).Row
            
            ' limits of existing data
            dtFirst = WorksheetFunction.Min(.Columns(COL_DATE))
            dtLast = WorksheetFunction.Max(.Columns(COL_DATE))
            'Debug.Print dtFirst, dtLast
              
            ' before first
            If dtDue < dtFirst Then
                .Rows("4").Insert
                r = 4
            ' after last
            ElseIf dtDue > dtLast Then
                r = Son_Dolu_Satir + 2
               
            ' find positon to insert
            Else
                For r = Son_Dolu_Satir To 4 Step -1
                    ' skip blanks
                    If .Cells(r, COL_DATE) <> "" Then
                       dt = .Cells(r, COL_DATE)
                       If dt = dtDue Then
                            r = r + 1
                            Exit For
                        ElseIf dt < dtDue Then
                            .Rows(r + 1).Insert
                            r = r + 2
                            Exit For
                        End If
                    End If
                Next
            End If
            
            ' update sheet
            If r >= 4 Then
                .Rows(r).Insert
                .Cells(r, COL_DATE) = dtDue
                .Cells(r, "E") = TextBox1.Text
                .Cells(r, "F") = num
                .Cells(r, "H") = ComboBox1.Text
                .Cells(r, "J") = TextBox6.Text
                MsgBox "Added row " & r, vbInformation
            Else
                MsgBox "Nothing Added", vbExclamation
            End If
        End With
        
    End Sub