Match Textbox entry with cells to populate column with Userform data - excel

Question

I currently have multiple spreadsheets with a row of dates for each employee.
Within the userform that pops up modified for each employee, there is a place for the date at the top, and they fill out the rest of the information and then submit.
Is there a way to match up the date on the sheet with the one on the userform to populate the column underneath?

Answer 1

Assuming you have a textbox on your form that you type the date into.
This first bit of code is ensuring you have a date in the textbox rather than anything else.
Paste this into a normal module. You can place it in the form, but in a module allows it to be used by any other forms you may have that contain a date.
Public Sub FormatDate(ctrl As Control)
Dim dDate As Date
Dim IsDate As Boolean
On Error GoTo ERR_HANDLE
If Replace(ctrl.Value, " ", "") <> "" Then
On Error Resume Next
dDate = CDate(ctrl.Value)
IsDate = (Err.Number = 0)
On Error GoTo -1
On Error GoTo ERR_HANDLE
If IsDate Then
ctrl.Value = Format(ctrl.Value, "dd-mmm-yyyy")
ctrl.BackColor = RGB(255, 255, 255)
Else
ctrl.BackColor = RGB(255, 0, 0)
End If
End If
EXIT_PROC:
On Error GoTo 0
Exit Sub
ERR_HANDLE:
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "FormatDate()"
Resume EXIT_PROC
End Sub
Place this on the form as the AfterUpdate event for your textbox:
Private Sub txtDate_AfterUpdate()
On Error GoTo ERR_HANDLE
With Me
FormatDate .txtDate
End With
EXIT_PROC:
On Error GoTo 0
Exit Sub
ERR_HANDLE:
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "txtDate_AfterUpdate()"
Resume EXIT_PROC
End Sub
Any valid date will be formatted as dd-mmm-yyyy, any invalid date will turn the background of the control red.
Next you need to find the date on row 1 of your sheet. Again this can be kept in a normal module so you can use it outside of the form:
Public Function FindDate(DateValue As Date) As Range
Dim rFound As Range
With Sheet2
Set rFound = .Rows(1).Find(DateValue, .Cells(1, 1), xlValues, xlWhole)
If rFound Is Nothing Then
Set rFound = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1)
End If
End With
Set FindDate = rFound
End Function
This will return the cell that the date is in or the last blank cell on row 1 if the date isn't found.
I'm not sure if you want this bit, but this then finds the last cell containing data in a specified column number:
Public Function LastCell(wrksht As Worksheet, Col As Long) As Range
Dim lLastRow As Long
On Error Resume Next
lLastRow = wrksht.Columns(Col).Find("*", , , , xlByColumns, xlPrevious).Row
On Error GoTo 0
If lLastRow = 0 Then lLastRow = 1
Set LastCell = wrksht.Cells(lLastRow, Col)
End Function
Now you just need to attach the code to your find button to return the first blank cell beneath the date you specify:
Private Sub btnFind_Click()
Dim rFoundCell As Range
'First blank cell beneath date.
Set rFoundCell = LastCell(Sheet1, FindDate(CDate(Me.txtDate)).Column).Offset(1)
End Sub
If you just wanted to find the date you can just use:
Set rFoundCell = FindDate(CDate(Me.txtDate))
The help file on Find is here.
Finding dates can be problematic in Excel:
excel-vba-range-find-date-that-is-a-formula
DateTimeVBA