Just showing the MsgBox line of code is not enough to diagnose this. Please show all the code for the UserForm with the problem. (I suggest you use code tags when pasting code. You can select the code then click the VBA button to mark the code. This will preserve the original spacing in your code to help readability.)
Hi Jeff
Here is the entire code for the User Form.
As I mentioned, the code for adding and updating details are exactly the same as for another user form in a seprate worksheet in the same workbook. The only exception is that the source and range details have been changed to provide the corresponding details. Details from the other user form are all inputted into the worksheet before the message box appears.
With this code, only the first detail
Cells(lastrow + 1, "A").Value = cboPLType are uploaded into the worksheet before the message box appears and the remaining details are only uploaded once the message box is acknowledged. This happens for both the Add and Update commands.
I have used the same structured code to add and update informstion in a number of user forms and files and this is the only form where this occurs.
Any help would be most welcome
User Form Code
Dim Currentrow As Long
Private Sub FullDetails_Click()
End Sub
Private Sub UserForm_Initialize()
cboPLType.Value = ""
txtPLClass.Value = ""
txtPLSubClass.Value = ""
txtPLBRNumber.Value = ""
txtPLCurrentNumber.Value = ""
txtPLPreviousNumbers.Value = ""
txtPLStockName.Value = ""
DTPicker2.Value = ""
txtPLStockLocation.Value = ""
txtPLBRNumberSearch.Value = ""
txtPLCurrentNumberSearch.Value = ""
txtPLClass.SetFocus
End Sub
Private Sub txtPLBRNumber_Change()
'Converts text to upper case
txtPLBRNumber.Text = UCase(txtPLBRNumber.Text)
End Sub
Private Sub txtPLCurrentNumber_Change()
'Converts text to upper case
txtPLCurrentNumber.Text = UCase(txtPLCurrentNumber.Text)
End Sub
Private Sub txtPLPreviousNumbers_Change()
'Converts text to upper case
txtPLPreviousNumbers.Text = UCase(txtPLPreviousNumbers.Text)
End Sub
Private Sub txtPLBRNumberSearch_Change()
'Converts text to upper case
txtPLBRNumberSearch.Text = UCase(txtPLBRNumberSearch.Text)
End Sub
Private Sub txtPLCurrentNumberSearch_Change()
'Converts text to upper case
txtPLCurrentNumberSearch.Text = UCase(txtPLCurrentNumberSearch.Text)
End Sub
Private Sub cmdAddNewPLRecord_Click()
'Used to add new records to the Preserved Locomotives Database
Dim lastrow As Long
Dim StockNumber As String
StockNumber = txtPLBRNumber
If Application.WorksheetFunction.CountIf(Sheets("Preserved Locomotives").Range("D4:D1500"), StockNumber) > 0 Then
MsgBox "Stock Number Already Exists", 0, "Duplication Check"
Call UserForm_Initialize
txtPLClass.SetFocus
Exit Sub
End If
lastrow = Sheets("Preserved Locomotives").Range("A" & Rows.Count).End(xlUp).Row
Cells(lastrow + 1, "A").Value = cboPLType
Cells(lastrow + 1, "B").Value = txtPLClass
Cells(lastrow + 1, "C").Value = txtPLSubClass
Cells(lastrow + 1, "D").Value = txtPLBRNumber
Cells(lastrow + 1, "E").Value = txtPLCurrentNumber
Cells(lastrow + 1, "F").Value = txtPLPreviousNumbers
Cells(lastrow + 1, "G").Value = txtPLStockName
Cells(lastrow + 1, "H").Value = DTPicker2
Cells(lastrow + 1, "I").Value = txtPLStockLocation
MsgBox txtPLBRNumber & " has been added to the Preserved Locomotive database", 0, "Stock Number Added"
Call UserForm_Initialize
txtPLClass.SetFocus
End Sub
Private Sub cmdPLBRNumberSearch_Click()
'Used to search for a unique BR stock number if the Preserved Locomotives database and return all corresponding values to the user form
Dim Res As Variant
Dim lastrow
Dim myFind As String
Res = Application.Match(txtPLBRNumberSearch, Sheets("Preserved Locomotives").Range("D4:D1500"), 0)
If IsError(Res) Then
MsgBox "Stock Number Not Found", vbInformation, "Stock Number Not Found"
Call UserForm_Initialize
cboPLType.SetFocus
Exit Sub
End If
lastrow = Sheets("Preserved locomotives").Range("D" & Rows.Count).End(xlUp).Row
myFind = txtPLBRNumberSearch
For Currentrow = 2 To lastrow
If Cells(Currentrow, 4).Text = myFind Then
cboPLType.Value = Cells(Currentrow, 1).Value
txtPLClass.Value = Cells(Currentrow, 2).Value
txtPLSubClass.Value = Cells(Currentrow, 3).Value
txtPLBRNumber.Value = Cells(Currentrow, 4).Value
txtPLCurrentNumber.Value = Cells(Currentrow, 5).Value
txtPLPreviousNumbers.Value = Cells(Currentrow, 6).Value
txtPLStockName.Value = Cells(Currentrow, 7).Value
DTPicker2.Value = Cells(Currentrow, 8).Value
txtPLStockLocation.Value = Cells(Currentrow, 9).Value
Exit For
End If
Next Currentrow
txtPLClass.SetFocus
End Sub
Private Sub cmdPLCurrentNumberSearch_Click()
'Used to search for a unique current stock number if the Preserved Locomotives database and return all corresponding values to the user form
Dim Res As Variant
Dim lastrow
Dim myFind As String
Res = Application.Match(txtPLCurrentNumberSearch, Sheets("Preserved Locomotives").Range("E4:E1500"), 0)
If IsError(Res) Then
MsgBox "Stock Number Not Found", vbInformation, "Stock Number Not Found"
Call UserForm_Initialize
cboPLType.SetFocus
Exit Sub
End If
lastrow = Sheets("Preserved Locomotives").Range("E" & Rows.Count).End(xlUp).Row
myFind = txtPLCurrentNumberSearch
For Currentrow = 2 To lastrow
If Cells(Currentrow, 5).Text = myFind Then
cboPLType.Value = Cells(Currentrow, 1).Value
txtPLClass.Value = Cells(Currentrow, 2).Value
txtPLSubClass.Value = Cells(Currentrow, 3).Value
txtPLBRNumber.Value = Cells(Currentrow, 4).Value
txtPLCurrentNumber.Value = Cells(Currentrow, 5).Value
txtPLPreviousNumbers.Value = Cells(Currentrow, 6).Value
txtPLStockName.Value = Cells(Currentrow, 7).Value
DTPicker2.Value = Cells(Currentrow, 8).Value
txtPLStockLocation.Value = Cells(Currentrow, 9).Value
Exit For
End If
Next Currentrow
txtPLClass.SetFocus
End Sub
Private Sub cmdUpdatePLRecord_Click()
'Used to update existing records
answer = MsgBox("Update the Record?", vbYesNo + vbQuestion, "Update Record?")
If answer = vbNo Then
Call UserForm_Initialize
cboPLType.SetFocus
Else
Cells(Currentrow, 1).Value = cboPLType.Value
Cells(Currentrow, 2).Value = txtPLClass.Value
Cells(Currentrow, 3).Value = txtPLSubClass.Value
Cells(Currentrow, 4).Value = txtPLBRNumber.Value
Cells(Currentrow, 5).Value = txtPLCurrentNumber.Value
Cells(Currentrow, 6).Value = txtPLPreviousNumbers.Value
Cells(Currentrow, 7).Value = txtPLStockName.Value
Cells(Currentrow, 8).Value = DTPicker2.Value
Cells(Currentrow, 9).Value = txtPLStockLocation.Value
MsgBox "Record has been updated", 0, "Record Updated"
Call UserForm_Initialize
txtPLBRNumberSearch.SetFocus
End If
End Sub
Private Sub cmdClearPLForm_Click()
'Clears the User Form
Call UserForm_Initialize
End Sub
Private Sub cmdClosePLForm_Click()
'Closes the User Form
Unload Me
End Sub
