Forum Discussion
Ella123
Feb 14, 2025Copper Contributor
Preventing the user from going to the next page in UserFrom
Hello , like the title says I have a problem in the UserForm.When the fields are blank in the first page(employee) then if the user clicks on the second page (training) , the message should pop-up an...
Ella123
Feb 18, 2025Copper Contributor
Here it is :
Ella123
Feb 19, 2025Copper Contributor
if some reason the sent excel file still doesn't appear , here is the whole code :
Private Sub MultiPage1_Change()
Dim isValid As Boolean
isValid = True
' Check if user is trying to navigate to Page 2 (Training)
If MultiPage1.Value = 1 Then
isValid = ValidateFields()
If Not isValid Then
MsgBox "Please complete all employee fields before proceeding to the Training page."
' Ensure you're setting MultiPage back to Page 1, and refresh
MultiPage1.Value = 0
Me.Repaint
Else
' Load the training list as navigating to Page 2 now
Call LoadTrainingList("")
End If
End If
End Sub
Private Sub Update_Click()
Dim ws As Worksheet
On Error GoTo ErrorHandler
Set ws = ThisWorkbook.Sheets("Internal Tracking")
Dim empName As String, empRow As Range
Dim i As Long, newRow As Long
' Ensure all fields available
If Me.txtName.Value = "" Or Me.txtRole.Value = "" Or Me.txtID.Value = "" Or Me.txtSection.Value = "" Then
MsgBox "Please fill out all employee fields."
Exit Sub
End If
' Get employee information
empName = Me.txtName.Value
' Find or add employee
Set empRow = ws.Columns("A").Find(empName, LookIn:=xlValues, LookAt:=xlWhole)
If empRow Is Nothing Then
newRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
ws.Cells(newRow, 1).Value = empName
ws.Cells(newRow, 2).Value = Me.txtRole.Value
ws.Cells(newRow, 3).Value = Me.txtID.Value
ws.Cells(newRow, 4).Value = Me.txtSection.Value
Set empRow = ws.Cells(newRow, 1)
End If
' Prepare Collection for selected trainings
Dim selectedTrainings As Collection
Set selectedTrainings = New Collection
For i = 0 To Me.ListBox2.ListCount - 1
If Me.ListBox2.Selected(i) Then
selectedTrainings.Add Me.ListBox2.List(i)
End If
Next i
' Error handling for zero selections
If selectedTrainings.Count = 0 Then
MsgBox "No trainings selected."
Exit Sub
End If
' Process each selected training
Dim trainCol As Range
For Each trainName In selectedTrainings
Set trainCol = ws.Rows(3).Find(trainName, LookIn:=xlValues, LookAt:=xlWhole)
If Not trainCol Is Nothing Then
Dim completionDate As String
completionDate = InputBox("Enter completion date for " & trainName, "Completion Date", "")
If IsDate(completionDate) Then
ws.Cells(empRow.Row, trainCol.Column).Value = Format(completionDate, "mm/dd/yyyy")
ElseIf completionDate = "" Then
MsgBox "No date entered; skipping update for " & trainName
Else
MsgBox "Invalid date entered for " & trainName
End If
Else
MsgBox "Training column not found for " & trainName
End If
Next trainName
MsgBox "Employee training records updated!"
ErrorHandler:
MsgBox "An error occurred: " & Err.Description
Resume Next
End Sub
Private Function ValidateFields() As Boolean
' Initially assume all fields are valid
ValidateFields = True
' Check name field
If Me.txtName.Value = "" Then
Me.txtName.BackColor = RGB(255, 200, 200) ' Light red for missing data
ValidateFields = False
Else
Me.txtName.BackColor = RGB(255, 255, 255) ' Reset back color if correct
End If
' Check role field
If Me.txtRole.Value = "" Then
Me.txtRole.BackColor = RGB(255, 200, 200)
ValidateFields = False
Else
Me.txtRole.BackColor = RGB(255, 255, 255)
End If
' Check ID field
If Me.txtID.Value = "" Then
Me.txtID.BackColor = RGB(255, 200, 200)
ValidateFields = False
Else
Me.txtID.BackColor = RGB(255, 255, 255)
End If
' Check section field
If Me.txtSection.Value = "" Then
Me.txtSection.BackColor = RGB(255, 200, 200)
ValidateFields = False
Else
Me.txtSection.BackColor = RGB(255, 255, 255)
End If
End Function
Private Sub ResetFieldColors()
' Set back to default color
Me.txtName.BackColor = RGB(255, 255, 255) ' White
Me.txtRole.BackColor = RGB(255, 255, 255)
Me.txtID.BackColor = RGB(255, 255, 255)
Me.txtSection.BackColor = RGB(255, 255, 255)
End Sub
Private Sub Training_Initialize()
With Cancel
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 40) ' Set border color
.BorderWidth = 4 ' Set border width (thickness)
End With
With Update
SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 40) ' Set border color
.BorderWidth = 4 ' Set border width (thickness)
End Sub
Private Sub Cancel_Click()
Dim answer As VbMsgBoxResult
answer = MsgBox("Are you sure you want to cancel?", vbYesNo + vbQuestion, "Cancel Confirmation")
If answer = vbYes Then
Unload Me ' This will close the UserForm
End If
End Sub
Private Sub UserForm1_Initialize()
' Set the initial page to Employee (Page1, assuming index 0)
MultiPage1.Value = 0
' Set the background color of the UserForm
Me.BackColor = RGB(102, 172, 204)
' Ensure all relevant controls are reset or visible/invisible as needed
ResetFieldColors
' Start/resetting particular fields or visibility information here if required
End Sub
Private Sub txtSearch_Change()
Call LoadTrainingList(Me.txtSearch.Text)
End Sub
Private Sub LoadTrainingList(searchTerm As String)
Dim ws As Worksheet
On Error GoTo ErrorHandler
Set ws = ThisWorkbook.Sheets("L2_Internal Tracking")
Dim i As Long, lastCol As Long, MatchFound As Boolean
lastCol = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column
Me.ListBox2.Clear
MatchFound = False
For i = 5 To lastCol
Dim strTrainName As String
strTrainName = ws.Cells(3, i).Value
If InStr(1, strTrainName, searchTerm, vbTextCompare) > 0 Then
Me.ListBox2.AddItem strTrainName
MatchFound = True
End If
Next i
If Not MatchFound And searchTerm <> "" Then
MsgBox "The Training is not found"
End If
Exit Sub
ErrorHandler:
MsgBox "An error occurred during training list loading: " & Err.Description
End Sub