Solved: Date Format Problems

[Rob342]

Hi
I have a user form which a user can select dates from a calendar, when its writing the dates back to the worksheet it is intermittently changing the date format back to US, along with this I am calculating the numbers of days between the 2 dates, which is screwing the calculation
Can anybody point me the right direction to cure this
Using excel 2010, all options set up to UK English

This is the code I'm using

.cells(IRow, "N").Value = CDate(Me.TxtJCDate.Value)


Calculation

.cells(IRow, "DD").Value = DateValue(Me.TxtLCDate.Value) - DateValue(Me.TxtJCDate.Value)


And as a last resort

Private Sub TxtJCDate_Change()
Me.TxtJCDate.Value = Format(Me.TxtJCDate.Value, "DD/MM/YYYY")
End Sub


In debug mode the format is correct (UK) from the calendar
And it still converts the dates back to US format ???????
Rob

[Ringhal]

Are your regional settings for your computer set correctly?

[mohanvijay]

try changing the cells format


Range("n:n).NumberFormat = "DD/MM/YYYY"

[Rob342]

Hi mohanvijay

All regional setting are ok set to UK English
I did try this and got the same results

I have even set the columns to * Date, Text & Numbers, in your opinion what it the best way to set the columns as ( Date, Text or ? )
Rob

[mohanvijay]

If Range("n:n").NumberFormat = "DD/MM/YYYY" does not work then
date in "n" column must be as text

try this



.cells(IRow, "N").Value = CLng(CDate(Me.TxtJCDate.Value))

'After this change cell format

Range("n:n").NumberFormat = "DD/MM/YYYY"

[snb]

All resulting in the correct values:


Sub M_snb()
With Cells(10, 1)
.NumberFormat = "general"
.Value = CDate("09-01-2013")
With .Offset(1)
.NumberFormat = "general"
.Value = Format("09-01-2013", "yyyy-mm-dd")
End With
With .Offset(2)
.NumberFormat = "general"
.Value = DateValue("09-01-2013")
End With
End With
End Sub

[SamT]

This is the code I'm using
.cells(IRow, "N") = CDate(Me.TxtJCDate)

Calculation
.cells(IRow, "DD") = CDate(CLng(Me.TxtLCDate) - CLng(Me.TxtJCDate))

[Rob342]

Thanks SamT, snb, mohanvijay

I give this a try tomorrow and give you an update

Rob

[Rob342]

Hi Guys

Have tested the code its is now writing back in the correct format on the sheet, which has highlighted another problem.
When I extract and copy the sheet to a new workbook the values are all ok, but when I import that sheet back into my main programme it changes the dates again to US format.
This is the code used for the import

Sub Upload_DL_Prg_MDB()
'// Programme Updates Page 11
' Copy The MDB database back in to Dams Prograame
'
Dim WBMDB As Workbook ' this is where the data is coming from Dams Dtabase D_MDB.xls or .xlsx
Dim WBDAMS As Workbook ' this is where the data is going to Dams Database sheet MDB
Dim wsMDB As Worksheet 'This is the worksheet from workbook WBMDB
Dim wsDAMS As Worksheet 'this is the worksheet for the active workbook ie DAMS
Dim Files As String
Dim FilePath As String
Dim LastRow As Long
Dim LastRowData As Long
Dim cells As Range
Dim FileExtStr As String
Dim FileFormatNum As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False

FilePath = "C:\DAMS\"
Files = "DL_Prg_MDB"
FileExtStr = ".xlsx"

On Error GoTo ExitMsg ' Runtime error "1004" if no file found !!

Workbooks.Open (FilePath & Files & FileExtStr)

Set WBMDB = Workbooks(Files & FileExtStr) 'DownLoaded File workbook
Set wsMDB = WBMDB.Worksheets("MDB") 'Downloaded database file MDB sheet
Set WBDAMS = Workbooks("DamsNew.xlsm") ' DAMS main programme workbook & database
Set wsDAMS = WBDAMS.Worksheets("MDB") ' Dams main programme database sheet

LastRowData = wsMDB.cells(wsMDB.Rows.Count, "A").End(xlUp).Row ' Transmitted database file M_MDB. *
'lastRow = wsDAMS.cells(wsDAMS.Rows.Count, "A").End(xlUp).Row ' Dams main database & programme.xls or xlsm

'// Open up the workbooks downloaded File, copy the data into the DAMS main database sheet MDB
With WBMDB.Worksheets("MDB")
.cells.Copy
WBMDB.Close 'Savechanges = True
End With

ThisWorkbook.Activate
Application.CutCopyMode = True
With Worksheets("MDB")
.Activate
.Visible = True
.cells.PasteSpecial
Application.CutCopyMode = False
.Visible = xlSheetVeryHidden
End With
'// Kill the file when uploaded !!!
Kill "C:\DAMS\DL_Prg_MDB" & FileExtStr
MsgBox "File Uploaded Press Ok to Continue, Please Select The Next Upload", , "Data File Uploaded"

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
ExitMsg:
MsgBox "Dams Data File Not Found, Please Check If There Is a File or Misspelled", , "No M_MDB.xlsx Data File"

Exit Sub

End Sub



.cells.PasteSpecial xlpasteValuesAndNumberFormats
doesn't work, errors out, Do I need to change .cells to a range ?
Rob

[snb]

Did you try (probably the same result your code produces) ?


Sub M_snb()
with getobject("C:\DAMS\DL_Prg_MDB.xlsx")
.sheets("MDB").copy ,thisworkbook.sheets(thisworkbook.sheets.count)
.close 0
end with
End Sub

[SamT]

???
With WBMDB.Worksheets("MDB")
.Cells.Copy Destination:=ThisWorkbook.Worksheets("MDB").Range("A1")
WBMDB.Close 'Savechanges = True
End With

[Rob342]

Snb

I didn't try that, can this be modified to copy over the original sheet or appended to data that is already there.( All date formats are ok)

SamT

Works a treat and dates are ok, can I apply a range to this
for example
Destination:=ThisWorkbook.Worksheets("MDB").Range("A1P & IRow")
Rob

[SamT]

WBMDB.Worksheets("MDB").Cells.Copy
Copies every cell on the sheet, so, no, it won't fit unless it's pasted in A1..

However, This will only C&P some of the sheet.
WBMDB.Worksheets("MDB").UsedRange.Copy _
Destination:= (Any Single-Cell reference)

Even If using a multi-cell Destination range, the actual paste range will be the exact size of the copied range.

[snb]

Sub M_snb()
With getobject("C:\DAMS\DL_Prg_MDB.xlsx")
.sheets("MDB").cells(1).currentregion.copy thisworkbook.sheets("MDB").cells(rows.count,1).end(xlup).offset(1)
.close 0
End With
End Sub

[Rob342]

HI SamT & snb

Tried both options all work ok and the speed is quicker and its not changing any of the dates now.............
SamT
I tried this with the range all ok

With WBMDB.Worksheets("MDB").UsedRange
.Range("A2:DP" & LastRowData).Copy _
Destination:=ThisWorkbook.Worksheets("MDB").Range("A" & LastRow + 1)
WBMDB.Close
End With


Snb
Hard to believe only 4 lines of code does the same thing, I did rem out the offset so that the header copied over the original one on the sheet.

Many thanks to both of you for your time, most appreciated.

Rob

[SamT]

Rob,

snb writes the tightest code possible. It is well worth the effort of analyzing his examples.

I write code that is as easy to understand as possible. This makes my code very verbose.

[Rob342]

Hi Sam

I Like easy to understand code, I always try to understand snb's code its so slick but not always easy to decipher.

Once again thanks for the help, i'll mark this as solved ok

Rob