• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Runtime error '13' Type Mismatch. CDate

Y

Yodelayheewho

Member
The code below was working perfectly until yesterday.

The code prevents the user from 'forgetting' to save before exiting the userform.
Here's an example of what's happening
1. Enter a date in txtReqPM but do not click the Save command button
2. Click on Exit command button
2. Select 'yes' to save changes
3. Runtime error 13. Type mismatch pops up
4. Debugs on the very next textbox, which is txtPMAssign
5. I end the debug and it unloads the userform
6. I reopen the userform, search for the same order to see if date in txtReqPM is saved and it is.
7. So, the Exit code is working as far as saving if I select 'yes', but I'm getting this error.

Because the debug was highlighted the next textbox, I double checked that my columns were aligned correctly and they are: txtReqPM is in Column 66 and txtPMAssign is in Column 67 and so forth.

Code: 
'Exit Button'
Private Sub cmbExit_Click()
If MsgBox("Save changes?", vbYesNo, "Exit form") = vbYes Then
Dim Shop_Order_Number As String
Dim n As String
Dim txt As String
n = txtNotes 'Overrides the default limit of characters in a textbox; allows unlimited characters***
Shop_Order_Number = Trim(txtShopOrdNum)
lastrow = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If Worksheets("Master").Cells(i, 4).Value = Shop_Order_Number Then
'redacted Columns 1-60'
Worksheets("Master").Cells(i, 61).Value = txtSrvTtl
Worksheets("Master").Cells(i, 62).Value = cboSrvGrp
Worksheets("Master").Cells(i, 63).Value = CDate(Me.txtConPO.Value)
Worksheets("Master").Cells(i, 64).Value = CDate(Me.txtE10.Value)
Worksheets("Master").Cells(i, 65).Value = CDate(Me.txtFinance.Value)
Worksheets("Master").Cells(i, 66).Value = CDate(Me.txtReqPM.Value)
Worksheets("Master").Cells(i, 67).Value = CDate(Me.txtPMAssign.Value)
Worksheets("Master").Cells(i, 68).Value = CDate(Me.txtSOATeam.Value)
Worksheets("Master").Cells(i, 69).Value = CDate(Me.txtApproved.Value)
Worksheets("Master").Cells(i, 70).Value = CDate(Me.txtSOACust.Value)
Worksheets("Master").Cells(i, 71).Value = CDate(Me.txtSOAE10.Value)
Worksheets("Master").Cells(i, 72).Value = CDate(Me.txtAR.Value)
Worksheets("Master").Cells(i, 73).Value = CDate(Me.txtCurPromDate.Value)
Worksheets("Master").Cells(i, 74).Value = CDate(Me.cboRecRev.Value)
Worksheets("Master").Cells(i, 75).Value = txtShipNotes
Worksheets("Master").Cells(i, 76).Value = CDate(Me.txtShipped.Value)
Worksheets("Master").Cells(i, 77).Value = txtName
Worksheets("Master").Cells(i, 78).Value = txtDiamond
Worksheets("Master").Cells(i, 79).Value = txtCustID
'redated Columns 80 -102'
End If
Next
ActiveWorkbook.Save
MsgBox "Your work is saved", vbOKOnly, "Exit form"
    Else
    End If
Unload MasterForm
End Sub

Thank you in advance for your help.
 
Yodelayheewho said:
. Debugs on the very next textbox, which is txtPMAssign
Click to expand...

Code: 
Worksheets("Master").Cells(i, 67).Value = CDate(Me.txtPMAssign.Value)

It means that the value of textbox txtPMAssign, whatever it is, cannot be converted to type Date. So for example, if txtPMAssign.Value = "dog" you will get the error, but if it something that is plausibly numeric ("44000") you will not.
 
By the way, your code will look a lot simpler (and run a lot faster) if you don't make Excel look up Worsheets("Master").Cells each time. Like this:
Code: 
Set ows = Worksheets("Master")
Set ocs = ows.Cells
For i = 2 To lastrow
  If ocs(i, 4).Value = Shop_Order_Number Then
    'redacted Columns 1-60'
    ocs(i, 61).Value = txtSrvTtl
    ocs(i, 62).Value = cboSrvGrp
    ocs(i, 63).Value = CDate(Me.txtConPO.Value)
    ocs(i, 64).Value = CDate(Me.txtE10.Value)
    ' ...and so on
    End If
  Next i
About that troublesome date: You can check to be sure it's a valid date, and keep the program from abending with error number 13, by using the IsDate function, something like this:
Code: 
vd = Me.txtPMAssign.Value
If Not IsDate(vd) then 'do some error routine, display a message or something
ocs(i, 67).Value = CDate(vd)
 
As @BobBridges has suggested, you can rewrite your sub to use arrays instead of ranges/cells which is a bit more efficient & faster. But if you wanted to retain the same basic structure as your existing code, something like this would work. If the value in the text box cannot be converted in to a date, then the corresponding spreadsheet cell will show the text "no date".
Code: 
'Exit Button'
Private Sub cmbExit_Click()
    If MsgBox("Save changes?", vbYesNo, "Exit form") = vbYes Then
        Dim Shop_Order_Number As String
        Dim n As String
        'Dim txt As String                             'not used in code
        Dim LastRow As Long, i As Long                'always declare variables
        Dim NewDataWrittenToWorksheet As Boolean

        NewDataWrittenToWorksheet = False

        n = txtNotes                                  'Overrides the default limit of characters in a textbox; allows unlimited characters***
        Shop_Order_Number = Trim(txtShopOrdNum)

        With Worksheets("Master")
            LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
            For i = 2 To LastRow
                If .Cells(i, 4).Value = Shop_Order_Number Then
                    'redacted Columns 1-60'
                    .Cells(i, 61).Value = txtSrvTtl
                    .Cells(i, 62).Value = cboSrvGrp

                    'Set date default
                    .Range(.Cells(i, 63), .Cells(i, 76)).Value = "No date"

                    'Turn off error checking
                    On Error Resume Next

                    'Process userform date text boxes.
                    .Cells(i, 63).Value = CDate(Me.txtConPO.Value)
                    .Cells(i, 64).Value = CDate(Me.txtE10.Value)
                    .Cells(i, 65).Value = CDate(Me.txtFinance.Value)
                    .Cells(i, 66).Value = CDate(Me.txtReqPM.Value)
                    .Cells(i, 67).Value = CDate(Me.txtPMAssign.Value)
                    .Cells(i, 68).Value = CDate(Me.txtSOATeam.Value)
                    .Cells(i, 69).Value = CDate(Me.txtApproved.Value)
                    .Cells(i, 70).Value = CDate(Me.txtSOACust.Value)
                    .Cells(i, 71).Value = CDate(Me.txtSOAE10.Value)
                    .Cells(i, 72).Value = CDate(Me.txtAR.Value)
                    .Cells(i, 73).Value = CDate(Me.txtCurPromDate.Value)
                    .Cells(i, 74).Value = CDate(Me.cboRecRev.Value)
                    .Cells(i, 76).Value = CDate(Me.txtShipped.Value)

                    'Restore error checking
                    On Error GoTo 0

                    .Cells(i, 75).Value = txtShipNotes
                    .Cells(i, 77).Value = txtName
                    .Cells(i, 78).Value = txtDiamond
                    .Cells(i, 79).Value = txtCustID
                    'redated Columns 80 -102'

                    NewDataWrittenToWorksheet = True
                End If
            Next i
        End With

        If NewDataWrittenToWorksheet Then
            ActiveWorkbook.Save
            MsgBox "Your work is saved", vbOKOnly, "Exit form"
        Else
            MsgBox "No changes made. No need to save", vbOKOnly, "Exit form"
        End If
    Else
    End If
    Unload Me
End Sub

The above is only partially tested, since I cannot recreate your userform or data.
 
I really appreciate both of your responses and providing additional suggestions on how to make the code better. I want to tackle this once I resolve the date issue.

rlv01 said:
Code: 
Worksheets("Master").Cells(i, 67).Value = CDate(Me.txtPMAssign.Value)

It means that the value of textbox txtPMAssign, whatever it is, cannot be converted to type Date. So for example, if txtPMAssign.Value = "dog" you will get the error, but if it something that is plausibly numeric ("44000") you will not.
Click to expand...
All of the CDate textboxes are dates. The columns on the worksheet are formatted as dates.
BobBridges said:
By the way, your code will look a lot simpler (and run a lot faster) if you don't make Excel look up Worsheets("Master").Cells each time. Like this:
Code: 
Set ows = Worksheets("Master")
Set ocs = ows.Cells
For i = 2 To lastrow
  If ocs(i, 4).Value = Shop_Order_Number Then
    'redacted Columns 1-60'
    ocs(i, 61).Value = txtSrvTtl
    ocs(i, 62).Value = cboSrvGrp
    ocs(i, 63).Value = CDate(Me.txtConPO.Value)
    ocs(i, 64).Value = CDate(Me.txtE10.Value)
    ' ...and so on
    End If
  Next i
About that troublesome date: You can check to be sure it's a valid date, and keep the program from abending with error number 13, by using the IsDate function, something like this:
Code: 
vd = Me.txtPMAssign.Value
If Not IsDate(vd) then 'do some error routine, display a message or something
ocs(i, 67).Value = CDate(vd)
Click to expand...
Bob, I have 16 columns of dates, so would I need to do this for each date?
 
Well, yes and no. You would want to check each date, but you don't have to write out all of that 16 times. Write a separate function and call it for each of the date fields, something like this. (In this code I'm using jr for the row, and I'm assuming that Me.txtFinance (for example) is a cell in a worksheet; if that's wrong it may take some adjustment. Also I believe you don't have to specify "Me" each time, but if I'm mistaken about that you'll find out.)
Code: 
Set ows = Worksheets("Master")
Set ocs = ows.Cells
For jr = 2 To lastrow
  If ocs(jr, 4).Value <> Shop_Order_Number Then GoTo IterateRow
  ocs(jr, 61).Value = txtSrvTtl
  ocs(jr, 62).Value = cboSrvGrp
  ocs(jr, 63).Value = CheckDate(txtConPO)
  ocs(jr, 64).Value = CheckDate(txtE10)
  ocs(jr, 65).Value = CheckDate(txtFinance)
  ocs(jr, 66).Value = CheckDate(txtReqPM)
  ocs(jr, 67).Value = CheckDate(txtPMAssign)
  ocs(jr, 68).Value = CheckDate(txtSOATeam)
  ocs(jr, 69).Value = CheckDate(txtApproved)
  ocs(jr, 70).Value = CheckDate(txtSOACust)
  ocs(jr, 71).Value = CheckDate(txtSOAE10)
  ocs(jr, 72).Value = CheckDate(txtAR)
  ocs(jr, 73).Value = CheckDate(txtCurPromDate)
  ocs(jr, 74).Value = CheckDate(cboRecRev)
  ocs(jr, 75).Value = txtShipNotes.Value
  ocs(jr, 76).Value = CheckDate(txtShipped)
  ocs(jr, 77).Value = txtName
  ocs(jr, 78).Value = txtDiamond
  ocs(jr, 79).Value = txtCustID
  Exit For
IterateRow:
  Next jr

' blah, blah, blah
End Sub

' Check a value and convert to date format.
Function CheckDate(oc) 'oc is the cell containing the value we want to convert
  vd = oc.Value
  If Not IsDate(vd) Then 'do some error routine, display a message or something
  CheckDate = CDate(vd)
  End Function
The "Exit For" statement at the end drops out of the loop once you find the matching Shop_Order_Number; otherwise the program would waste it's time looking through the rest of the rows even after it had done what you want.
 
Yodelayheewho said:
All of the CDate textboxes are dates.
Click to expand...
No, textboxes contain text. You may intend for the text in a particular text box to represent a date, but that does not mean it does. And from the error message you are getting, at least one of those textboxes contains something that cannot be converted to a date with the CDATE function.

Yodelayheewho said:
I want to tackle this once I resolve the date issue.
Click to expand...
The code I posted does resolve the situation where the text box contains something that cannot be converted to a date.
 
BobBridges said:
Well, yes and no. You would want to check each date, but you don't have to write out all of that 16 times. Write a separate function and call it for each of the date fields, something like this. (In this code I'm using jr for the row, and I'm assuming that Me.txtFinance (for example) is a cell in a worksheet; if that's wrong it may take some adjustment. Also I believe you don't have to specify "Me" each time, but if I'm mistaken about that you'll find out.)
Code: 
Set ows = Worksheets("Master")
Set ocs = ows.Cells
For jr = 2 To lastrow
  If ocs(jr, 4).Value <> Shop_Order_Number Then GoTo IterateRow
  ocs(jr, 61).Value = txtSrvTtl
  ocs(jr, 62).Value = cboSrvGrp
  ocs(jr, 63).Value = CheckDate(txtConPO)
  ocs(jr, 64).Value = CheckDate(txtE10)
  ocs(jr, 65).Value = CheckDate(txtFinance)
  ocs(jr, 66).Value = CheckDate(txtReqPM)
  ocs(jr, 67).Value = CheckDate(txtPMAssign)
  ocs(jr, 68).Value = CheckDate(txtSOATeam)
  ocs(jr, 69).Value = CheckDate(txtApproved)
  ocs(jr, 70).Value = CheckDate(txtSOACust)
  ocs(jr, 71).Value = CheckDate(txtSOAE10)
  ocs(jr, 72).Value = CheckDate(txtAR)
  ocs(jr, 73).Value = CheckDate(txtCurPromDate)
  ocs(jr, 74).Value = CheckDate(cboRecRev)
  ocs(jr, 75).Value = txtShipNotes.Value
  ocs(jr, 76).Value = CheckDate(txtShipped)
  ocs(jr, 77).Value = txtName
  ocs(jr, 78).Value = txtDiamond
  ocs(jr, 79).Value = txtCustID
  Exit For
IterateRow:
  Next jr

' blah, blah, blah
End Sub

' Check a value and convert to date format.
Function CheckDate(oc) 'oc is the cell containing the value we want to convert
  vd = oc.Value
  If Not IsDate(vd) Then 'do some error routine, display a message or something
  CheckDate = CDate(vd)
  End Function
The "Exit For" statement at the end drops out of the loop once you find the matching Shop_Order_Number; otherwise the program would waste it's time looking through the rest of the rows even after it had done what you want.
Click to expand...

This is so cool! The error messages are gone! The only thing that's not working is saving the data. I'm assuming it's a small tweak?

Code: 
'Exit Button'
Private Sub cmbExit_Click()
If MsgBox("Save changes?", vbYesNo, "Exit form") = vbYes Then
Dim Shop_Order_Number As String
Dim n As String
Dim txt As String
n = txtNotes 'Overrides the default limit of characters in a textbox; allows unlimited characters***
Shop_Order_Number = Trim(txtShopOrdNum)
'lastrow = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row
Set ows = Worksheets("Master")
Set ocs = ows.Cells
For i = 2 To lastrow
If ocs(i, 4).Value <> Shop_Order_Number Then GoTo IterateRow
ocs(i, 1).Value = txtPrefix
ocs(i, 2).Value = cboStatus
ocs(i, 3).Value = txtSuffix
ocs(i, 4).Value = txtShopOrdNum
ocs(i, 5).Value = txtEmailSubLine
ocs(i, 6).Value = txtNotes
ocs(i, 7).Value = cboStage
ocs(i, 8).Value = CheckDate(txtStartDate)
ocs(i, 9).Value = CheckDate(txtStageDue)
ocs(i, 10).Value = CheckDate(txtEndDate)
'redacted columns 11-99'
ocs(i, 100).Value = txtEUName
ocs(i, 101).Value = txtEUID
ocs(i, 102).Value = txtTimestamp
Exit For 'drops out of the loop once you find the matching Shop_Order_Number; preventing the program from wasting time looking through the rest of the rows even after finding the match
IterateRow:
Next i
ActiveWorkbook.Save
MsgBox "Your work is saved", vbOKOnly, "Exit form"
  Else
  End If
Unload MasterForm
End Sub

'Check value and convert to date format
Function CheckDate(oc) 'oc is the cell containing the value we want to convert
vd = oc.Value
If Not IsDate(vd) Then 'do some error routine, display a message or something
CheckDate = CDate(vd)
End Function
 
The code itself is running so much better, but I still can't get it to save. I tried changing the msgbox/save part of the code to this and still my data will not save to the worksheet. I get no error messages.

Code: 
Exit For 'drops out of the loop once you find the matching Shop_Order_Number; preventing the program from wasting time looking through the rest of the rows even after finding the match
IterateRow:
Next i
If MsgBox("Save changes?", vbYesNo, "Exit form") = vbYes Then ThisWorkbook.Save 'NOT WORKING
MsgBox "Your work is saved", vbOKOnly, "Exit form"
Unload MasterForm
End Sub 'Exit Form Button
 
Weird, but the response below showed up on my email, but not in the post. So, here it is...

Exit For 'drops out of the loop once you find the matching Shop_Order_Number; preventing the program from wasting time looking through the rest of the rows even after finding the match
IterateRow:
>>> use code - tags <<<
Code: 
Next i
ows.Cells.Value = ocs  '<--------- missing
ActiveWorkbook.Save
MsgBox "Your work is saved", vbOKOnly, "Exit form"
  Else
  End If
Unload MasterForm
End Sub
Ok so I tried this and got an error...

Code: 
'Exit Button'
Private Sub cmbExit_Click()
Dim Shop_Order_Number As String
Dim n As String
Dim txt As String
Shop_Order_Number = Trim(txtShopOrdNum)
'lastrow = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row
Set ows = Worksheets("Master")
Set ocs = ows.Cells
For i = 2 To lastrow
If ocs(i, 4).Value <> Shop_Order_Number Then GoTo IterateRow
ocs(i, 1).Value = txtPrefix
ocs(i, 2).Value = cboStatus
ocs(i, 3).Value = txtSuffix
ocs(i, 4).Value = txtShopOrdNum
ocs(i, 5).Value = txtEmailSubLine
ocs(i, 6).Value = txtNotes
ocs(i, 7).Value = cboStage
ocs(i, 8).Value = CheckDate(txtStartDate)
ocs(i, 9).Value = CheckDate(txtStageDue)
ocs(i, 10).Value = CheckDate(txtEndDate)
'redacted columns 11-102'
Exit For 'drops out of the loop once you find the matching Shop_Order_Number; preventing the program from wasting time looking through the rest of the rows even after finding the match
IterateRow:
Next i
ows.Cells.Value = ocs 'Runtime error 1004, Application-defined or object-defined error
If MsgBox("Save changes?", vbYesNo, "Exit form") = vbYes Then
ThisWorkbook.Save 'Not saving
MsgBox "Your work is saved", vbOKOnly, "Exit form"
Else
End If
Unload MasterForm
End Sub 'Exit Form Button
 
Last edited by a moderator:
Remove the line that is causing the error. It should not be there. There is also really no need for that Goto instruction to be used.
 
Debaser said:
Remove the line that is causing the error. It should not be there. There is also really no need for that Goto instruction to be used.
Click to expand...
I followed your suggestions and have a new compile error at 'Next i'
Code: 
'Exit Button'
Private Sub cmbExit_Click()
Dim Shop_Order_Number As String
Dim n As String
Dim txt As String
n = txtNotes 'Overrides the default limit of characters in a textbox; allows unlimited characters***
Shop_Order_Number = Trim(txtShopOrdNum)
'lastrow = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row
Set ows = Worksheets("Master")
Set ocs = ows.Cells
For i = 2 To lastrow
If ocs(i, 4).Value <> Shop_Order_Number Then 'GoTo IterateRow removed this instruction
ocs(i, 1).Value = txtPrefix
ocs(i, 2).Value = cboStatus
ocs(i, 3).Value = txtSuffix
ocs(i, 4).Value = txtShopOrdNum
ocs(i, 5).Value = txtEmailSubLine
ocs(i, 6).Value = txtNotes
ocs(i, 7).Value = cboStage
ocs(i, 8).Value = CheckDate(txtStartDate)
ocs(i, 9).Value = CheckDate(txtStageDue)
ocs(i, 10).Value = CheckDate(txtEndDate)
'redacted columns 11-102'
Exit For 'drops out of the loop once you find the matching Shop_Order_Number; preventing the program from wasting time looking through the rest of the rows even after finding the match
IterateRow:
Next i 'Compile error: Next without For
'ows.Cells.Value = ocs 'Runtime error 1004, Application-defined or object-defined error. Removed this line
If MsgBox("Save changes?", vbYesNo, "Exit form") = vbYes Then
ThisWorkbook.Save 'Not saving
MsgBox "Your work is saved", vbOKOnly, "Exit form"
Else
End If
Unload MasterForm
End Sub 'Exit Form Button
 
You removed half a line. You need an End If line:

Code: 
Private Sub cmbExit_Click()
   Dim Shop_Order_Number As String
   Dim n As String
   Dim txt As String
   n = txtNotes
   Shop_Order_Number = Trim(txtShopOrdNum)
   'lastrow = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row
   Set ows = Worksheets("Master")
   Set ocs = ows.Cells
   For i = 2 To lastrow
      If ocs(i, 4).Value = Shop_Order_Number Then
         ocs(i, 1).Value = txtPrefix
         ocs(i, 2).Value = cboStatus
         ocs(i, 3).Value = txtSuffix
         ocs(i, 4).Value = txtShopOrdNum
         ocs(i, 5).Value = txtEmailSubLine
         ocs(i, 6).Value = txtNotes
         ocs(i, 7).Value = cboStage
         ocs(i, 8).Value = CheckDate(txtStartDate)
         ocs(i, 9).Value = CheckDate(txtStageDue)
         ocs(i, 10).Value = CheckDate(txtEndDate)
         'redacted columns 11-102'
         Exit For 'drops out of the loop once you find the matching Shop_Order_Number; preventing the program from wasting time looking through the rest of the rows even after finding the match
      End If
   Next i
   If MsgBox("Save changes?", vbYesNo, "Exit form") = vbYes Then
      ThisWorkbook.Save 'Not saving
      MsgBox "Your work is saved", vbOKOnly, "Exit form"
   End If
   Unload MasterForm
End Sub 'Exit Form Button
 
Debaser said:
You removed half a line. You need an End If line:

Code: 
Private Sub cmbExit_Click()
   Dim Shop_Order_Number As String
   Dim n As String
   Dim txt As String
   n = txtNotes
   Shop_Order_Number = Trim(txtShopOrdNum)
   'lastrow = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row
   Set ows = Worksheets("Master")
   Set ocs = ows.Cells
   For i = 2 To lastrow
      If ocs(i, 4).Value = Shop_Order_Number Then
         ocs(i, 1).Value = txtPrefix
         ocs(i, 2).Value = cboStatus
         ocs(i, 3).Value = txtSuffix
         ocs(i, 4).Value = txtShopOrdNum
         ocs(i, 5).Value = txtEmailSubLine
         ocs(i, 6).Value = txtNotes
         ocs(i, 7).Value = cboStage
         ocs(i, 8).Value = CheckDate(txtStartDate)
         ocs(i, 9).Value = CheckDate(txtStageDue)
         ocs(i, 10).Value = CheckDate(txtEndDate)
         'redacted columns 11-102'
         Exit For 'drops out of the loop once you find the matching Shop_Order_Number; preventing the program from wasting time looking through the rest of the rows even after finding the match
      End If
   Next i
   If MsgBox("Save changes?", vbYesNo, "Exit form") = vbYes Then
      ThisWorkbook.Save 'Not saving
      MsgBox "Your work is saved", vbOKOnly, "Exit form"
   End If
   Unload MasterForm
End Sub 'Exit Form Button
Click to expand...
The errors are gone! I really like how much faster it processes. However, ThisWorkbook.Save is not saving.
Here is my updated code based on your suggestions.
Code: 
'Exit Button'
Private Sub cmbExit_Click()
Dim Shop_Order_Number As String
Dim txt As String
Shop_Order_Number = Trim(txtShopOrdNum)
Set ows = Worksheets("Master")
Set ocs = ows.Cells
For i = 2 To lastrow
If ocs(i, 4).Value = Shop_Order_Number Then
ocs(i, 1).Value = txtPrefix
ocs(i, 2).Value = cboStatus
ocs(i, 3).Value = txtSuffix
ocs(i, 4).Value = txtShopOrdNum
ocs(i, 5).Value = txtEmailSubLine
ocs(i, 6).Value = txtNotes
ocs(i, 7).Value = cboStage
ocs(i, 8).Value = CheckDate(txtStartDate)
ocs(i, 9).Value = CheckDate(txtStageDue)
ocs(i, 10).Value = CheckDate(txtEndDate)
'redacted columns 11-102'
Exit For
End If
Next i
If MsgBox("Save changes?", vbYesNo, "Exit form") = vbYes Then
    ThisWorkbook.Save 'NOT WORKING
    MsgBox "Your work is saved", vbOKOnly, "Exit form"
End If
Unload MasterForm
End Sub
 
While I'm not getting an error message, the updates are not being saved. See image...
Save not working on exit.jpg
Is it possible the issue is that Set ows and Set ocs do not have corresponding Dim?
 
The code is in the Userform.
I thought maybe not have "DIM" for ows and ocs was the issue. I added this and no luck.
Is it possible the reason it won't save has to do with the loop?

Code: 
'Exit Button'
Private Sub cmbExit_Click()
Dim Shop_Order_Number As String
Dim txt As String
Dim ows As Worksheet 'Added this'
Dim ocs As Range 'Added this'
Shop_Order_Number = Trim(txtShopOrdNum)
Set ows = Worksheets("Master")
Set ocs = ows.Cells
For i = 2 To lastrow
If ocs(i, 4).Value = Shop_Order_Number Then
ocs(i, 1).Value = txtPrefix
ocs(i, 2).Value = cboStatus
ocs(i, 3).Value = txtSuffix
ocs(i, 4).Value = txtShopOrdNum
ocs(i, 5).Value = txtEmailSubLine
ocs(i, 6).Value = txtNotes
ocs(i, 7).Value = cboStage
ocs(i, 8).Value = CheckDate(txtStartDate)
ocs(i, 9).Value = CheckDate(txtStageDue)
ocs(i, 10).Value = CheckDate(txtEndDate)
'redacted columns 11-102'
Exit For
End If
Next i
If MsgBox("Save changes?", vbYesNo) = vbYes Then
    ThisWorkbook.Save
    txt = "Your work is saved."
  Else
    txt = "Your work was NOT saved."
    'NOT WORKING 
    'MsgBox "Your work is saved", vbOKOnly, "Exit form"
End If
MsgBox txt
Unload MasterForm
End Sub
 
Is the userform in the workbook that you are trying to save, or is it in a different workbook/add-in?
 
You are making assumptions that are not reasonable for you to make given you have an unknown problem. You should not trust your userform or worksheet to correctly report the saved filedate/time. That could easily be a coding error on your part.

Put this test sub in the same code module where Private Sub cmbExit_Click() is located, and use it to test your save function.

Code: 
Sub SaveTest()
    Dim Msg As String
    Dim FFile As Object
    Dim FSize As Variant

    If MsgBox("Save changes?", vbYesNo, "Exit form") = vbYes Then
        With CreateObject("Scripting.FileSystemObject")
            Set FFile = .getfile(ThisWorkbook.FullName)
            With FFile
                Msg = "File: " & FFile.Name & vbCr
                Msg = Msg & "Before Save: " & vbCr
                Msg = Msg & "Date Created: " & FFile.datecreated & vbCr
                Msg = Msg & "Date Last Modified: " & FFile.DateLastModified & vbCr
                Msg = Msg & Round(FFile.Size / 1024, 1) & " KB" & vbCr & vbCr

                ThisWorkbook.Save                     'NOT WORKING

                MsgBox "Your work is saved", vbOKOnly, "Exit form"

                Msg = Msg & "After Save:" & vbCr
                Msg = Msg & "Date Created: " & FFile.datecreated & vbCr
                Msg = Msg & "Date Last Modified: " & FFile.DateLastModified & vbCr
                  Msg = Msg & Round(FFile.Size / 1024, 1) & " KB" & vbCr & vbCr
            End With
        End With
    Else
        Msg = "User Cancelled"
    End If
    MsgBox Msg
End Sub

1687799990692.png
 
I'm not sure if I'm doing this right...
Test 1
I entered your code directly above the cmbExit_Click() event.
I opened the userform, changed a date, clicked on Exit, clicked on "Yes" to save changes, "your work is saved" message appears, then I get another msgbox that is blank with an 'ok' button. I click on 'ok'. The date change is not saved.

Test 2
I followed the same steps but instead of clicking on the Exit command button, I clicked on the Save command button. Got a message saying "your work is saved". This works fine.

I must be doing something wrong, because the msgbox that you show doesn't pop up during either test.

Code: 
Sub SaveTest()
    Dim Msg As String
    Dim FFile As Object
    Dim FSize As Variant

    If MsgBox("Save changes?", vbYesNo, "Exit form") = vbYes Then
        With CreateObject("Scripting.FileSystemObject")
            Set FFile = .getfile(ThisWorkbook.FullName)
            With FFile
                Msg = "File: " & FFile.Name & vbCr
                Msg = Msg & "Before Save: " & vbCr
                Msg = Msg & "Date Created: " & FFile.datecreated & vbCr
                Msg = Msg & "Date Last Modified: " & FFile.DateLastModified & vbCr
                Msg = Msg & Round(FFile.Size / 1024, 1) & " KB" & vbCr & vbCr

                ThisWorkbook.Save                     'NOT WORKING

                MsgBox "Your work is saved", vbOKOnly, "Exit form"

                Msg = Msg & "After Save:" & vbCr
                Msg = Msg & "Date Created: " & FFile.datecreated & vbCr
                Msg = Msg & "Date Last Modified: " & FFile.DateLastModified & vbCr
                  Msg = Msg & Round(FFile.Size / 1024, 1) & " KB" & vbCr & vbCr
            End With
        End With
    Else
        Msg = "User Cancelled"
    End If
    MsgBox Msg
End Sub

'Exit Button'
Private Sub cmbExit_Click()
Dim Shop_Order_Number As String
Dim txt As String
Dim ows As Worksheet
Dim ocs As Range
Shop_Order_Number = Trim(txtShopOrdNum)
Set ows = Worksheets("Master")
Set ocs = ows.Cells
For i = 2 To lastrow
If ocs(i, 4).Value = Shop_Order_Number Then
ocs(i, 1).Value = txtPrefix
ocs(i, 2).Value = cboStatus
ocs(i, 3).Value = txtSuffix
ocs(i, 4).Value = txtShopOrdNum
ocs(i, 5).Value = txtEmailSubLine
ocs(i, 6).Value = txtNotes
ocs(i, 7).Value = cboStage
ocs(i, 8).Value = CheckDate(txtStartDate)
ocs(i, 9).Value = CheckDate(txtStageDue)
ocs(i, 10).Value = CheckDate(txtEndDate)
'redacted columns 11-102'
Exit For
End If
Next i
If MsgBox("Save changes?", vbYesNo, "Exit form") = vbYes Then
    ThisWorkbook.Save 'NOT WORKING
    MsgBox "Your work is saved", vbOKOnly, "Exit form"
End If
MsgBox txt
Unload MasterForm
End Sub
 
You must log in or register to reply here.
Back
Top