Copy Range to new Range and keep DATE format??

[HammerJoe]

Hi,

I have this code :

Sheets("Settings").Range(TempWeekRange + "3" + ":" + TempWeekRange +
"8").Value = _
Sheets("Settings").Range(TempWeekRange + "10" + ":" + TempWeekRange
+ "15").Value

TempWeekRange is a string variable that will point to a column.

IE : M10:M15
23/06/2008
09/06/2008
12/05/2008
16/06/2008
Never
05/05/2008

I have set up the format for this range "dd/mm/yyyy"
The problem is that the code above copies the data to the range M3:M8
as :
6/23/2008
06/09/2008
05/12/2008
6/16/2008
Never
05/05/2008

The format is all wrong, despite having it formatted the same "dd/mm/
yyyy"
I've tried Sheets("Settings").Range(TempWeekRange + "3" + ":" +
TempWeekRange + "8").NumberFormat = "dd/mm/yyyy" before and after and
it doesnt work.

Besides splitting each row into :

Sheets("Settings").Range(TempWeekRange + "3" + ":" + TempWeekRange +
"8").Value = _
FORMAT(Sheets("Settings").Range(TempWeekRange + "10" + ":" +
TempWeekRange + "15").Value,"dd/mmm/yyyy")

Is there an easier way, to keep it a single line?

 

[HammerJoe]

Sorry I meant:

Sheets("Settings").Range(TempWeekRange + "3").Value = _
FORMAT(Sheets("Settings").Range(TempWeekRange + "10").Value,"dd/mmm/
yyyy")

 

[HammerJoe]

Sorry I meant:

 Sheets("Settings").Range(TempWeekRange + "3").Value = _
 FORMAT(Sheets("Settings").Range(TempWeekRange + "10").Value,"dd/mmm/
yyyy")

Why cant I copy between the range and keep the date format without
excel messing it up?

 

[Dave Peterson]

You can.

But this isn't doing any copy or paste.

Record a macro when you do it manually and you'll have the code you need.

 

[HammerJoe]

Hi,

I know about the copy and paste, but why

Sheets("Settings").Range(TempWeekRange + "3" + ":" + TempWeekRange +
"8").Value = Sheets("Settings").Range(TempWeekRange + "10" + ":" +
TempWeekRange + "15").Value

doesnt work when both ranges have the same format??

 

[HammerJoe]

I forgot to mention that the reason I am not doing a copy/paste is
because I dont want to have empty the clipboard because of this.

 

[Dave Peterson]

This is just assigning the values. It doesn't touch the format.

Since you don't want to do copy|paste in your code, you could try this:

Dim SourceRng As Range
Dim DestCell As Range

With Sheets("Settings")
Set SourceRng = .Cells(10, TempWeekRange).Resize(6, 1)
Set DestCell = .Cells(3, TempWeekRange)
End With

With SourceRng
DestCell.Resize(.Rows.Count, .Columns.Count).NumberFormat = .NumberFormat
DestCell.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With

==========
But I think you're in for a disappointment. Most macros that do anything will
kill the clipboard. This did for me.

 

[HammerJoe]

Still not working here, get exactly the same result...

I truly dont understand this.

Why only a couple cells are affected??

 

[Dave Peterson]

What result do you get? And what problem is happening?

What do you mean by only a couple of cells are affected?

 

[HammerJoe]

Heres an example:

RANGE M10:M15

23/06/2008
30/06/2008
12/05/2008
07/07/2008
Never
05/05/2008

based on format is dd/mm/yyyy

When using Sheets("Settings").Range(TempWeekRange + "3" + ":" +
TempWeekRange +
"8").Value = _
Sheets("Settings").Range(TempWeekRange + "10" + ":" + TempWeekRange
+ "15").Value or any other transfer other than copy and paste the
result is this on range M3:M8

6/23/2008
6/30/2008
05/12/2008
07/07/2008
Never
05/05/2008

it changes the format to mm/dd/yyyy which messes up calculations
afterwards.
The weird thing is that the first two rows I cannot change the format
of it, it is locked.

I dont understand this one.

 

[HammerJoe]

Another problem for the Copy and Paste solution is that Sheet Settings
is a hidden sheet and is never the Activesheet.

 

[Dave Peterson]

I don't see where you tried my suggestion--or how it failed.

 

[Dave Peterson]

Sheets don't have to be visible or even active to copy or paste.

 

[HammerJoe]

Dave I tried your example and it didnt work, same result.

Another tidbit is that if I use:

ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "3").Value =
Format(Sheets("Settings").Range(TempWeekRange + "10").Value, "dd/mmm/
yyyy")
ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "4").Value =
Format(Sheets("Settings").Range(TempWeekRange + "11").Value, "dd/mmm/
yyyy")
ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "5").Value =
Format(Sheets("Settings").Range(TempWeekRange + "12").Value, "dd/mmm/
yyyy")
ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "6").Value =
Format(Sheets("Settings").Range(TempWeekRange + "13").Value, "dd/mmm/
yyyy")
ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "7").Value =
Format(Sheets("Settings").Range(TempWeekRange + "14").Value, "dd/mmm/
yyyy")
ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "8").Value =
Format(Sheets("Settings").Range(TempWeekRange + "15").Value, "dd/mmm/
yyyy")

then it copies it properly with correct format.
The problem with it is that if there are other workbooks opened then
this is slow as mollasses and literally takes seconds to complete.
If it it the only workbook opened then it is fast.
Thats why I dont want to use this approach.

 

[HammerJoe]

Dave here is the code to help you figure it out.

I have 7 sheets named after the weekdays and one called "Month"
On the daily sheets i call this sub to update this list only if the
weekday is prior to todays date.
Also on each daily sheet it just referencies it to the Settings sheet
and are also formated as "ddmmyyyy", but that is no the problem.


Public Sub UpdateLastSalesDate(DailyWeek, SalesDateRange As Integer)
Dim StartWeek, EndWeek As Date
Dim TempWeekSheet, TempWeekRange As String
Dim Sales, NewWeekFlag As Integer
Application.ScreenUpdating = True
'dailyweek<8 means its called by one of the daily sheets
' and thats where I am having the trouble
If DailyWeek < 8 Then
'Get sheet name
TempWeekSheet = WeekdayName(DailyWeek)
'get the sales
Sales = ThisWorkbook.Sheets(TempWeekSheet).Range("N5").Value
'Used to get the column range starting with M
TempWeekRange = Chr(75 + DailyWeek)
If Sales > 5 Then Sales = 5
'ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "3").Value =
Format(Sheets("Settings").Range(TempWeekRange + "10").Value, "dd/mmm/
yyyy")
'ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "4").Value =
Format(Sheets("Settings").Range(TempWeekRange + "11").Value, "dd/mmm/
yyyy")
'ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "5").Value =
Format(Sheets("Settings").Range(TempWeekRange + "12").Value, "dd/mmm/
yyyy")
'ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "6").Value =
Format(Sheets("Settings").Range(TempWeekRange + "13").Value, "dd/mmm/
yyyy")
'ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "7").Value =
Format(Sheets("Settings").Range(TempWeekRange + "14").Value, "dd/mmm/
yyyy")
'ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "8").Value =
Format(Sheets("Settings").Range(TempWeekRange + "15").Value, "dd/mmm/
yyyy")

ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "3" + ":" +
TempWeekRange + "8").NumberFormat = _
ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "10" + ":" +
TempWeekRange + "15").NumberFormat
ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "3" + ":" +
TempWeekRange + "8").Value = _
ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "10" + ":" +
TempWeekRange + "15").Value
'update list only if it is a prior weekday not today
If DailyWeek < Weekday(Date) Then
'check number of boxes, if no boxes were available then dont update
sales#
If ThisWorkbook.Sheets(TempWeekSheet).Range("N9").Value > 0 Then
'ThisWorkbook.Sheets("Settings").Range(TempWeekRange + CStr(3 +
Sales)).Value = Format(Sheets("Settings").Range("E24").Value +
DailyWeek - 2, "dd/mmm/yyyy")
ThisWorkbook.Sheets("Settings").Range(TempWeekRange + CStr(3 +
Sales)).Value = CDate(Sheets("Settings").Range("E24").Value +
DailyWeek - 2)
End If
End If

Else
'Called by Monthly sheet or by end of the week sub
StartWeek = ThisWorkbook.Sheets("Settings").Range("E24").Value
EndWeek = StartWeek + SalesDateRange
If EndWeek > StartWeek + 7 Then EndWeek = StartWeek + 5
'flag for new week or daily check from monthlysheet
If SalesDateRange = 8 Then
NewWeekFlag = 10
Else
NewWeekFlag = 3
End If

Do While StartWeek < EndWeek
TempWeekRange = Chr(75 + Weekday(StartWeek))
TempWeekSheet = WeekdayName(Weekday(StartWeek))
Sales = ThisWorkbook.Sheets(TempWeekSheet).Range("N5").Value
If Sales > 5 Then Sales = 5
If ThisWorkbook.Sheets(TempWeekSheet).Range("N9").Value > 0 Then
ThisWorkbook.Sheets("Settings").Range(TempWeekRange +
CStr(NewWeekFlag + Sales)).Value = Format(StartWeek, "dd/mmm/yyyy")
End If
StartWeek = StartWeek + 1
Loop
If SalesDateRange = 8 Then
'funnily or not this one works.
ThisWorkbook.Sheets("Settings").Range("M3:R8").NumberFormat = _
ThisWorkbook.Sheets("Settings").Range("M10:R15").NumberFormat
ThisWorkbook.Sheets("Settings").Range("M3:R8").Value = _
ThisWorkbook.Sheets("Settings").Range("M10:R15").Value
End If
End If
Application.ScreenUpdating = False
End Sub

 

[Dave Peterson]

My suggestion worked in my testing.

I'm surprised that your code copied the formatting. I would have guessed excel
saw you were entering dates and just used its short date format--not the format
from the "sending" cells.

 

[Dave Peterson]

I'd still try the copy|paste or assigning both the .numberformat and .value.

 

[Dave Peterson]

I see you tried that.

I don't have another suggestion.

 

[HammerJoe]

Well I guess I will have to use

ThisWorkbook.Sheets("Settings").Range(TempWeekRange + "10" + ":" +
TempWeekRange + "15").Copy _
Destination:=ThisWorkbook.Sheets("Settings").Range(TempWeekRange +
"10" + ":" + TempWeekRange + "15")
At least this one works...

 

[Dave Peterson]

Does my first suggestion work in a test workbook?

Are you sure this worked?