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
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