Hello!
I have recently created a User Form for our compliance team to log all compliance items that require payment so we can track what needs deducting from their pay, among other reasons.
I keep having it flagged that people have submitted an item on the form, had the pop up saying it was successfully posted but then when they look at the Data tab, it's not there
As an audit log I recently added in to send an email confirming the item. I can now see that some emails are coming through, that when I then look at the Data tab, aren't there. So for some reason my code thinks it's been successful when it hasn't. The majority work fine, it's just the odd one that fails to go through.
Any ideas?
Full code below, most of it should be irrelevant but didn't want to miss anything out. The first sub is the one posting the data, then there is 2 after that to do with setting up the User Form and filling in the drop boxes
I have recently created a User Form for our compliance team to log all compliance items that require payment so we can track what needs deducting from their pay, among other reasons.
I keep having it flagged that people have submitted an item on the form, had the pop up saying it was successfully posted but then when they look at the Data tab, it's not there
As an audit log I recently added in to send an email confirming the item. I can now see that some emails are coming through, that when I then look at the Data tab, aren't there. So for some reason my code thinks it's been successful when it hasn't. The majority work fine, it's just the odd one that fails to go through.
Any ideas?
Full code below, most of it should be irrelevant but didn't want to miss anything out. The first sub is the one posting the data, then there is 2 after that to do with setting up the User Form and filling in the drop boxes
VBA Code:
Private Sub CommandButton1_Click()
'Checks the consultant has Wildcards available to be used
If TypeComboBox.Value = "Wildcard" Then
If WildcardTextBox.Value < 1 Then
MsgBox "No Wildcards Available"
Exit Sub
End If
End If
'Unlock the Data sheet ready for data to be posted
Sheets("Data").Unprotect Password:="1"
NextRow = Worksheets("Data").Cells(Rows.Count, 2).End(xlUp).Row + 1
'Checks for any blanks on the form and rejects the posting if so
With Me
If DateTextBox.Value = "" Then
MsgBox "Date is required"
Exit Sub
ElseIf UNComboBox1.Value = "" Then
MsgBox "Your name required"
Exit Sub
ElseIf LCTextBox.Value = "" Then
MsgBox "Locum Code required"
Exit Sub
ElseIf LNTextBox.Value = "" Then
MsgBox "Locum Name required"
Exit Sub
ElseIf ConsultantComboBox.Value = "" Then
MsgBox "Consultant required"
Exit Sub
ElseIf ItemComboBox.Value = "" Then
MsgBox "Description required"
Exit Sub
ElseIf TypeComboBox.Value = "" Then
MsgBox "Deduction Type required"
Exit Sub
End If
End With
'Copies the data from the form into the data sheet
Worksheets("Input").Range("A" & 2) = UNComboBox1.Value
Worksheets("Data").Range("B" & NextRow) = DateValue(DateTextBox.Value)
Worksheets("Data").Range("C" & NextRow) = LNTextBox.Value
Worksheets("Data").Range("D" & NextRow) = LCTextBox.Value
Worksheets("Data").Range("E" & NextRow) = UNComboBox1.Value
Worksheets("Data").Range("F" & NextRow) = ConsultantComboBox.Value
Worksheets("Data").Range("G" & NextRow) = ItemComboBox.Value
Worksheets("Data").Range("I" & NextRow) = AmountTextBox.Value
Worksheets("Data").Range("H" & NextRow) = TypeComboBox.Value
Worksheets("Data").Range("J" & NextRow) = EclipseCheckBox.Value
If TypeComboBox.Value = "Wildcard" Then
Worksheets("Data").Range("L" & NextRow) = DateValue(DateTextBox.Value)
Else
Worksheets("Data").Range("L" & NextRow) = "No"
End If
'save the workbook and then email the compliance officer and myself to confirm its done
ActiveWorkbook.Save
Dim OutApp As Object, OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Worksheets("Input").Range("B2").Value
.CC = Worksheets("Input").Range("A1").Value
.Subject = LCTextBox.Value & TypeComboBox.Value & ItemComboBox.Value
.HTMLBody = ""
.Send
End With
MsgBox "Successfully Submitted"
'Resets the form
DateTextBox.Value = Format(Date, "dd/mm/yyyy")
DateTextBox.Locked = True
LNTextBox.Value = ""
LCTextBox.Value = ""
UNComboBox1.Value = ""
ConsultantComboBox.Value = ""
ItemComboBox.Value = ""
AmountTextBox.Value = ""
TypeComboBox.Value = ""
EclipseCheckBox.Value = ""
With Worksheets("Data").UsedRange.Columns("B").Cells
.TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, FieldInfo:=Array(0, xlYMDFormat)
.NumberFormat = "dd/mm/yyyy"
End With
'Lock the Data sheet again as only Managers can amend the Data tab
Sheets("Data").Protect Password:="1"
Sheets("Data").Protect AllowFiltering:=True
End Sub
Private Sub ConsultantComboBox_Change()
Dim AvailableWildcards As String
On Error Resume Next
AvailableWildcards = WorksheetFunction.VLookup(ConsultantComboBox.Value, Worksheets("Wildcards").Range("A1:E47"), 5, False)
On Error GoTo 0
WildcardTextBox.Value = AvailableWildcards
WildcardTextBox.Locked = True
End Sub
Private Sub UserForm_Initialize()
Dim xRg As Range
DateTextBox.Value = Format(Date, "dd/mm/yyyy")
DateTextBox.Locked = True
Set xRg = Worksheets("Source").Range("B1:C13")
Me.ItemComboBox.List = xRg.Columns(1).Value
Set x2Rg = Worksheets("Source").Range("G1:G47")
Me.ConsultantComboBox.List = x2Rg.Columns(1).Value
Set x3Rg = Worksheets("Source").Range("K1:K7")
Me.TypeComboBox.List = x3Rg.Columns(1).Value
AmountTextBox.Locked = True
Set UNxRg = Worksheets("Source").Range("E1:E26")
Me.UNComboBox1.List = UNxRg.Columns(1).Value
End Sub
Private Sub ItemComboBox_Change()
On Error Resume Next
ItemCost = WorksheetFunction.VLookup(ItemComboBox.Value, Worksheets("Source").Range("B:C"), 2, False)
On Error GoTo 0
AmountTextBox.Value = ItemCost
AmountTextBox.Locked = True
End Sub
Private Sub LCTextBox_AfterUpdate()
If Len(Me.LCTextBox.Value) <> 9 Then
MsgBox "Please Check your Candidate Code - Incorrect Format"
Me.LCTextBox.Value = Left(Me.LCTextBox.Value, 50)
End If
On Error Resume Next
LocumName = WorksheetFunction.VLookup(LCTextBox.Value, Worksheets("TSP").Range("G:J"), 4, False)
On Error GoTo 0
On Error Resume Next
LNTextBox = LocumName
On Error GoTo 0
If LNTextBox <> "" Then
LNTextBox.Locked = True
Else: LNTextBox.Locked = False
End If
End Sub
