Hello I am trying to create a userform that is meant to both add data to a new row in my database. the code for this works. but i also want this userform to be able to search for data entered based on the reference number which is the first textbox on entry. so ive attempted for the form to search then repopulate my combo and text boxes then upon leaving the userform if anychanges have been made it updates it in the database
VB:
Code
Private Sub cmdClear_Click()
Me.Refbox.Value = ""
Me.Datebox.Value = ""
Me.ReasonBox.Value = ""
Me.BodyBox.Value = ""
Me.Depbox.Value = ""
Me.ColourBox.Value = ""
Me.materbox.Value = ""
Me.usage.Value = ""
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub Datebox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
ddate = DateSerial(Year(Date), Month(Date), Day(Date))
Datebox.Value = Format(Datebox.Value, "d/m/yyyy")
ddate = Datebox.Value
End Sub
Private Sub UserForm_Initialize()
On Error Resume Next
Dim cLoc As Range
Dim ws As Worksheet
Set ws = Worksheets("MasterColour")
Me.ColourBox.List = ws.Range("ColourList").Value
Application.EnableEvents = True
Set ws = Worksheets("MasterMaterial")
Me.materbox.List = ws.Range("Material").Value
'Me.ReasonBox.List = ws.Range("Arealist").Value
Me.Depbox.List = Array("Paint Shop", "Paint Shop Pop", "Design", "OWR", "Press Garage", "Prototype", "Other")
Me.Datebox.SetFocus
'me.Depbox.List = array("
End Sub
Private Sub Depbox_Change()
Dim icint As Integer
Dim ws As Worksheet
Set ws = Worksheets("MasterMaterial")
ReasonBox.Clear
With ReasonBox
Select Case Depbox
Case "Paint Shop"
Me.ReasonBox.List = ws.Range("Arealist").Value
End Select
End With
With ReasonBox
Select Case Depbox
Case "Paint Shop Pop"
.AddItem "Special FTT"
.AddItem "Stn 1380"
.AddItem "Stn 900"
.AddItem "Green room/Prep"
End Select
End With
With ReasonBox
Select Case Depbox
Case "Design"
.AddItem "New colour dev"
.AddItem "Trials"
.AddItem "Q"
End Select
End With
With ReasonBox
Select Case Depbox
Case "OWR"
.AddItem "Repair"
End Select
End With
With ReasonBox
Select Case Depbox
Case "Press Garage"
.AddItem "N/A"
End Select
End With
With ReasonBox
Select Case Depbox
Case "Prototype"
.AddItem "N/A"
End Select
End With
End Sub
Private Sub cmdAdd_click()
ActiveWorkbook.Sheets("Req").Activate
Range("A1").Select
Dim lrow As Long
Dim ctl As Control
lrow = Worksheets("Req").Range("A1").CurrentRegion.Rows.Count = 1
For Each ctl In Frame2.Controls
If TypeName(ctl) = "TextBox" Then
If ctl.Tag <> "" Then
ctl.ControlSource = ctl.Tag & lrow
End If
End If
Next ctl
'Colour validation
If ReasonBox.Text = Empty Then
MsgBox "Please choose an area", vbExclamation
Me.ReasonBox.SetFocus
Exit Sub
End If
If BodyBox.Text = Empty Then
MsgBox "Please enter a body number", vbExclamation
Me.BodyBox.SetFocus
Exit Sub
End If
If ColourBox.Text = Empty Then
MsgBox "Please select a colour"
Me.ColourBox.SetFocus
Exit Sub
End If
If materbox.Text = Empty Then
MsgBox "Please select materials"
Me.materbox.SetFocus
Exit Sub
End If
If usage.Text = Empty Then
MsgBox "Please enter usage amount"
Me.usage.SetFocus
Exit Sub
End If
'Date Validation
If Not IsDate(Datebox) Then
MsgBox "Input must be a date in the format: 'dd/mm/yyyy'"
Me.Datebox.SetFocus
Cancel = True
Exit Sub
Else
Datebox = Format(Datebox, "dd/mm/yyyy")
End If
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.Value = Refbox.Value
ActiveCell.Offset(0, 1) = Datebox.Value
ActiveCell.Offset(0, 2) = Depbox.Value
ActiveCell.Offset(0, 3) = ReasonBox.Value
ActiveCell.Offset(0, 4) = BodyBox.Value
ActiveCell.Offset(0, 5) = ColourBox.Value
ActiveCell.Offset(0, 6) = materbox.Value
ActiveCell.Offset(0, 7) = usage.Value
xxx = Split(Datebox.Value, "/")
ActiveCell.Offset(0, 1) = DateSerial(xxx(2), xxx(1), xxx(0))
'clear the data
Range("A1").Select
End Sub
Private Sub Search_Click()
Dim r As Range, rAll As Range, lrow As Long
Dim sTerm As String, ctl As Control
sTerm = txtDisplay.Value
With Sheets("Req")
Set rAll = .Range(.Cells(1, 3), .Cells(1, 3).End(xlDown))
For Each r In rAll
If InStr(r, sTerm) Then
lrow = r.Row
For Each ctl In Frame2.Controls
If TypeName(ctl) = "TextBox" Then
If ctl.Tag <> "" Then
ctl.ControlSource = ctl.Tag & lrow
End If
End If
Next ctl
End If
Next r
End With
End Sub
Display More