UserForm does not replace date formatting correctly

bensko

Board Regular
Joined
Mar 4, 2008
Messages
173
Any idea why my userform does not properly place the date back into my sheet. Checking the date format shows that proper formatting is there, but I get the "text date with 2 digit year" error. So far the only workaround would be to use the "=DATEVALUE" formula in several empty fields on the active row off to the right (starting at row 30), but not sure how I would use it with the userform code.

I started the first one in the code that places the data back onto the sheet below (in bold) but referencing the proper cell on the active row is where I am stuck.

Alternate options???

Not sure if enough info provided...? I appreciate any help in advance.

Ben

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ActiveSheet.Unprotect Password:="MASTER"
''''''READ ONLY MESSAGE FOLLOWS'''''
If ActiveWorkbook.ReadOnly Then
    Read_Only_Message 'In Module 5
End If
 ''''''END READ ONLY MESSAGE''''''''
Application.ScreenUpdating = True
Dim WSProject As Worksheet 'Added WS to project to indicate it's a worksheet
Set WSProject = Sheets("QUOTE STATUS")
Dim ThisCol As Integer
'Dim Thisrow As Integer
Dim MyDate As Variant
MyDate = Format(Now(), "mm/dd/yyyy")
ThisCol = Target.Column
Thisrow = Target.Row
On Error Resume Next
If ActiveCell.Value = "" Then
    MsgBox "YOU MUST SELECT A VALID RECORD or MAKE SURE YOU ARE NOT CLICKING ON AN EMPTY CELL"
    Exit Sub
End If
'If ThisCol = 1 Then
With Trans_Details
    .txtCtNo = WSProject.Cells(Thisrow, 2).Text
    .txtCustId = WSProject.Cells(Thisrow, 3).Text
    .txtProjectNo = WSProject.Cells(Thisrow, 15).Text
    .txtEquipDesc = WSProject.Cells(Thisrow, 4).Text
    .txtPoNo = WSProject.Cells(Thisrow, 5).Text
    .txtRep = WSProject.Cells(Thisrow, 6).Text
    .txtStatus = WSProject.Cells(Thisrow, 7).Text
    .txtValue = WSProject.Cells(Thisrow, 8).Text
    .txtPoNet = WSProject.Cells(Thisrow, 9).Text
    .txtRFQ = WSProject.Cells(Thisrow, 10).Text
    .txtQuoteDate = WSProject.Cells(Thisrow, 11).Text
    .txtTurnaround = WSProject.Cells(Thisrow, 12).Text
    .txtOrderDate = WSProject.Cells(Thisrow, 13).Text
    .txtPlanMU = WSProject.Cells(Thisrow, 16).Text
    .txtActMU = WSProject.Cells(Thisrow, 17).Text
    .txtPlanShip = WSProject.Cells(Thisrow, 18).Text
    .txtActShip = WSProject.Cells(Thisrow, 19).Text
    .txtInvoiced = WSProject.Cells(Thisrow, 20).Text
    .txtCode = WSProject.Cells(Thisrow, 21).Text
    .txtComments = WSProject.Cells(Thisrow, 23).Text
    .txtCallBack = WSProject.Cells(Thisrow, 24).Text
    .txtDate.Text = MyDate
  '' ChangeData is = False when variable is set now change it to true so it can be used in userform code
    ChangeData = True
      .show
End With
'End If
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowSorting:= _
        True, AllowFiltering:=True, Password:="MASTER"
End Sub

Code:
Private Sub cdEnter_Click()
ActiveSheet.Unprotect Password:="MASTER"
Application.ScreenUpdating = False '' set to false to prevent seeing screen flicker
Dim MyQuoteNr As Integer
Dim MyLen As Integer
Dim i As Integer
Dim lrow As Long
Dim Qws As Worksheet
Dim MySheet As Worksheet
Dim MyOrderDate As Date
Dim MyStartDate As Date
Dim WSProject As Worksheet 'Added WS to project to indicate it's a worksheet
Dim ODlrow As Long
Set MySheet = Worksheets("Comments")
Set Qws = Sheets("QUOTE STATUS")
lrow = MySheet.Range("A65536").End(xlUp).Row + 1 ''for hidden sheet assumes sheet has a header you could use offset
''' Check to see if changedata =  true ''
If ChangeData = True Then '' True value carried over from sheet3 code
If ActiveWorkbook.ReadOnly = True Then Exit Sub
 With Trans_Details
    Cells(Thisrow, 2).Value = .txtCtNo
    Cells(Thisrow, 3).Value = .txtCustId
    Cells(Thisrow, 15).Value = .txtProjectNo
    Cells(Thisrow, 4).Value = .txtEquipDesc
    Cells(Thisrow, 5).Value = .txtPoNo
    Cells(Thisrow, 6).Value = .txtRep
    Cells(Thisrow, 7).Value = .txtStatus
    Cells(Thisrow, 8).Value = .txtValue
    Cells(Thisrow, 9).Value = .txtPoNet
[B]'   Cells(Thisrow, 10).Value = .txtRFQ[/B]
[B]'   Cells(Thisrow, 10).NumberFormat = "mm/dd/yy;@"[/B]
[B]'   Cells(Thisrow, 30).Value = "=DATEVALUE(" + ")"[/B]
[B]'   Cells(Thisrow, 10).Value = values only of above formula[/B]
    Cells(Thisrow, 11).Value = .txtQuoteDate
    Cells(Thisrow, 11).NumberFormat = "mm/dd/yy;@"
'
'
    Cells(Thisrow, 12).Value = .txtTurnaround
    Cells(Thisrow, 13).Value = .txtOrderDate
    Cells(Thisrow, 13).NumberFormat = "mm/dd/yy;@"
'
' 
   Cells(Thisrow, 16).Value = .txtPlanMU
    Cells(Thisrow, 17).Value = .txtActMU
    Cells(Thisrow, 18).Value = .txtPlanShip
    Cells(Thisrow, 18).NumberFormat = "mm/dd/yy;@"
'
'
    Cells(Thisrow, 19).Value = .txtActShip
    Cells(Thisrow, 19).NumberFormat = "mm/dd/yy;@"
    Cells(Thisrow, 20).Value = .txtInvoiced
    Cells(Thisrow, 21).Value = .txtCode
    Cells(Thisrow, 22).Value = .txtComments
    Cells(Thisrow, 24).Value = .txtCallBack
    Cells(Thisrow, 24).NumberFormat = "mm/dd/yy;@"
'
'
    Cells(Thisrow, 26).Value = .txtDate
    Cells(Thisrow, 26).NumberFormat = "mm/dd/yy;@"
'
'
    '''''''''''''''''''''''''''''''''''''''''''
    MySheet.Cells(lrow, 1).Value = UCase(.txtCtNo) ''change to your sheet name
    MySubject = .txtCtNo & "  Customer: " & .txtCustId
    MySheet.Cells(lrow, 2).Value = .txtDate
'   MySheet.Cells(lrow, 2).NumberFormat = "mm/dd/yy;@"
    MySheet.Cells(lrow, 3).Value = UCase(.txtInitials)
    MyRep = UCase(.txtInitials)
    MySheet.Cells(lrow, 4).Value = (.txtComent)
    MyBody = (.txtComent)
    MyAddCC = .txtAddCC
    Send_Mail
'''''''''''
'Range("B65536").Select
'Selection.End(xlUp).Select
'With Range("AU1")
'    .Value = "0"
'    .Copy
'End With
'With ActiveCell
'    .PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd
'    .NumberFormat = "mm/dd/yy"
'End With
'Application.CutCopyMode = False
'Range("AU1").ClearContents
 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
  End With
  Worksheets("comments").Calculate
 ' ActiveCell.EntireRow.AutoFit
  Application.Goto Range("W" & ActiveCell.Row) ', True
  ActiveCell.Formula = ActiveCell.Formula
  ChangeData = False  '' reset to false but not really necessary because defalut value is false
                        ''' so each time you dbl click a record the variable is already set to false
                        '' except within the code for sheet3 we set it to true
End If
Application.DisplayAlerts = True
'ChangeData = False
Unload Trans_Details '''this will remove the userform when code is done'
  ActiveCell.EntireRow.AutoFit
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowSorting:= _
        True, AllowFiltering:=True, Password:="MASTER"
End Sub
Private Sub cmdDone_Click()
Application.DisplayAlerts = False
Application.Goto Range("A" & ActiveCell.Row) ', True
Unload Trans_Details
Application.DisplayAlerts = True
End Sub
Private Sub CommandButton1_Click()
End Sub
Private Sub txtCallBack_Enter()
    MyCalDate = Trans_Details.txtCallBack.Text
  Call OpenCalendar
  If MyDate = "" Then
    MyDate = MyCalDate
  End If
  Trans_Details.txtCallBack.Text = Format(MyDate, "mm/dd/yyyy")
  'Trans_Details.Repaint
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, _
                                CloseMode As Integer)
    If CloseMode <> vbFormCode Then
        Trans_Details.txtCallBack.Text = MyCalDate
        MsgBox "Use the Cancel button to close the form.", _
               vbOKOnly, "yourprogramname"
        Cancel = True
    End If
End Sub

Code:
Sub Read_Only_Message()
 Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "  TRACKER IS IN READ ONLY MODE...!" & vbCrLf & vbCrLf & "COMMENTS WILL NOT BE SAVED"    ' Define message."
Style = vbOKOnly + vbCritical + vbDefaultButton2    ' Define buttons.
Title = "READ ONLY"    ' Define title.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
End Sub

Code:
Option Explicit
''store varable in module so that it can be used in the worksheet code mod and userform code module
Public MyDate As String
Public MyCalDate As String
Public ChangeData As Boolean
Public Thisrow As Integer
 
Sub show()
frmData.show
End Sub

Code:
Sub ShowForm()
Dim MyDate
MyDate = Format(Date, "mm/dd/yy")
With frmData
.txtDate = MyDate
.show
End With
End Sub
 
Sub SearchForm()
.show
End With
End Sub
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

Forum statistics

Threads
1,215,644
Messages
6,125,993
Members
449,279
Latest member
Faraz5023

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top