Solved: Copy / Paste produce different results each time

[perhol]

Withh this code I am opening a csv-file, cleaning it nup to my purpose and coping it, then paste it in another file.
But when I paste it in, I do not always get the desired result.
After pasting the cells in the date columns appear with different delimiters, and cells in the hour format does not appear constant in [T]: mm format

Here is my code:

Option Explicit
Sub NyeData()
Dim FileToOpen
Dim FileSaveName
Dim WSD As Worksheet
Dim PRange As Range
Dim FinalRow As Long
Dim FinalCol As Long
ChDir "C:\"

FileToOpen = Application _
.GetOpenFilename("Text Files (*.csv), *.csv")
If FileToOpen = False Then Exit Sub

Workbooks.OpenText Filename:= _
FileToOpen, origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), _
TrailingMinusNumbers:=True

'Data are being cleaned up
Range("B:B,F:F").Select
Range("F1").Activate
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Replace What:=".", Replacement:=":", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="""", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Sort Key1:=Range("E1"), Order1:=xlAscending, Key2:=Range("A1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Selection.Columns.AutoFit

'Data are being copyed and transferred to my file
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows("TEST_ARK2.xls").Activate
ActiveSheet.Paste
Columns("A:A").Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

End Sub

What do i do wrong?

[draco664]

What do i do wrong?

You could try adding -

Selection.PasteSpecial Paste:=xlPasteFormats

after the line -

ActiveSheet.Paste

Good luck,

Chris

[perhol]

Selection.PasteSpecial Paste:=xlPasteFormats has no effect.
It seems that the error occurs in the file I open and clean.
The error occurs when I remove the quotation with this code:
Selection.Replace What:="""", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
The rows look like this before the quotes are removed:

"31/01/11 ""Træning Rasmus"" ""16:00"" ""19:00"" ""Rasmus"""
"01/02/11 ""Christian fri"" ""07:00"" ""10:00"" ""Christian""" and like this when the code has removed the quotes:

31/01/11 Træning Rasmus 16:00 19:00 Rasmus
02-01-2011 Christian fri 07:00 10:00 Christian If I double-click in the cells with this date format:

31/01/11 and then move the cursor to another cell, the cell with the incorrect format is changed to the desired format:

31-01-2011
How do I avoid that these errors occur?

Before there were also errors in the way hours were shown, but this error is gone for the moment.

[mdmackillop]

Can you post a csv with a few rows of data?

[perhol]

I have not tried to attach a file before, but here is my attempt.
The file comes from an IPhone, s calendar.

[draco664]

Have you tried changing the code so that you copy the data to the new worksheet first and then change the formatting?

Chris

[perhol]

Yes.
Same result

[mdmackillop]

Option Explicit

Sub Macro1()
Dim Data
Dim arr()
Dim a
Dim Rw As Long, Col As Long
Dim i As Long, j As Long
Dim t

Cells.ClearContents

With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\AAA\dates.csv", _
Destination:=Range("$A$1"))
.Name = "dates"
.Refresh BackgroundQuery:=False
End With

Columns("A:A").Replace What:="""", Replacement:="", LookAt:=xlPart

Columns("C:C").NumberFormat = "dd/mm/yy"
Columns("H:H").NumberFormat = "dd/mm/yy"
Columns("D:D").NumberFormat = "[hh]:mm"
Columns("F:G").NumberFormat = "hh:mm"

Set Data = Range("a1").CurrentRegion

Rw = Range("$A$1").CurrentRegion.Rows.Count
Col = UBound(Split(Application.Index(Data, 1, 0), ";"))

ReDim arr(Rw, Col)
For i = 1 To Rw - 1
a = Split(Application.Index(Data, i + 1, 0), ";")
For j = 0 To Col
Select Case j
Case 0, 5
arr(i, j) = a(j)
Case 3, 4
t = Split(a(j), ".")
arr(i, j) = (CInt(t(0)) + (CInt(t(1)) / 60)) / 24
Case 1
arr(i, j) = Val(a(j)) / 24
Case Else
arr(i, j) = a(j)
End Select
Next
Next

Cells(1, 3).Resize(Rw + 1, Col + 1) = arr
End Sub

[perhol]

mdmackillop>
I get almost the same result with your code.

In my first code I open the data file to a new sheet, remove the row 1 and column 2 (they are not necessary), remove unwanted characters from the rest and replace dot with colon.

I chose the method because I knew how I could use a file open dialog in it.
I knew that a data import directly to the sheet would be more effective, but I did not know how I could use a file open dialog with direct data import.

I want to use an open file dialog because the data file changes its name every time there's a new one.

I have found out that detail now, but still dates are formatted incorrectly.

It seems that all dates starting with a zero will be formatted as dd-mm-yy, while all dates that does not begin with a zero will be formatted as dd/mm/yy.

I attach the new file and hope that you or someone else can solve the last little problem.

I have removed all comments from VBA code and translated the few texts in the work sheet into English.

[perhol]

The previously uploaded file can of course be used as a data source for this spreadsheet.

[mdmackillop]

Apologies, I missed that bit
Change my code to Case 0, 5
d = Split(a(j), "/")
arr(i, j) = DateSerial(d(2), d(1), d(0))

[perhol]

mdmackillop>

Thank you.

That was what it took.

I have merged it into my own code. So now the spreadsheet is working as I want it to.

I bow respectfully. :bow:

PS.: Do you want me to upload a copy?

[mdmackillop]

A working version is always useful to others viewing the thread so please do so.
Happy to have helped
Regards
MD

[perhol]

Okay, here it is. :wavey:

[mdmackillop]

Hi Perhol.
Get rid of Selection in your code. It is very rarely required
Instead of
'Sletter data i arkene
Sheets("TimeReg").Select
Range("A8:E308").Select
' Range(Selection, Selection.End(xlDown)).Select
Selection.Clear
Range("A8").Select
Sheets("DataKopi").Select
Range("A1:E1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Clear
Range("A1").Select

This reduces to
'Sletter data i arkene
Sheets("TimeReg").Range("A8:E308").Clear
Sheets("DataKopi").Range("A1:E1").End(xlDown).Clear

Much quicker to run, to debug and maintain.

[perhol]

I have followed your advice on 'Select' in the code.
However, it seems that I have to choose 'Select' in the end, because the code below expects a cell selected as active.
I paste all the code from the file here. I have removed all comments.

From Sheet1 (TimeReg):
Private Sub CommandButton1_Click()
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Call HentData
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub From Module 1:
Option Explicit

Sub HentData()

Sheets("TimeReg").Range("A8:E308").Clear
Sheets("DataKopi").Columns("A:E").Delete Shift:=xlToLeft
Sheets("DataKopi").Select
Range("A1").Select

Dim Data
Dim arr()
Dim a
Dim d
Dim Rw As Long, Col As Long
Dim i As Long, j As Long
Dim t
Dim sPath As String
Dim fName As String
Dim s As String
s = CurDir
Dim myRange As String
Dim str As String
Dim myLen As Long
Dim cnt As Long
Dim sname As String

sPath = "C:\Users\Per Holst\Desktop\Flemming Tejlmand\"
ChDrive sPath
ChDir sPath
fName = Application.GetOpenFilename( _
Filefilter:="CSV Files (*.CSV),*.CSV")
ChDrive s
ChDir s
If LCase(fName) = "false" Then Exit Sub
With ActiveSheet.QueryTables.Add _
(Connection:="TEXT;" & fName, _
Destination:=Range("$A$1"))
.Name = ""
.Refresh BackgroundQuery:=False
End With

Columns("A:A").Replace What:="""", Replacement:="", LookAt:=xlPart

Columns("C:C").NumberFormat = "dd/mm/yyyy"
Columns("H:H").NumberFormat = "dd/mm/yyyy"
Columns("D:D").NumberFormat = "[hh]:mm"
Columns("F:G").NumberFormat = "hh:mm"

Set Data = Range("a1").CurrentRegion

Rw = Range("$A$1").CurrentRegion.Rows.Count
Col = UBound(Split(Application.Index(Data, 1, 0), ";"))

ReDim arr(Rw, Col)
For i = 1 To Rw - 1
a = Split(Application.Index(Data, i + 1, 0), ";")
For j = 0 To Col
Select Case j
Case 0, 5
d = Split(a(j), "/")
arr(i, j) = DateSerial(d(2), d(1), d(0))
Case 3, 4
t = Split(a(j), ".")
arr(i, j) = (CInt(t(0)) + (CInt(t(1)) / 60)) / 24
Case 1
arr(i, j) = Val(a(j)) / 24
Case Else
arr(i, j) = a(j)
End Select
Next
Next

Cells(1, 3).Resize(Rw + 1, Col + 1) = arr

Rows("1:1").Delete Shift:=xlUp
Range("A:A,B:B,D:D,H:H").Delete Shift:=xlToLeft

Columns("A:E").AutoFit

Columns("A:E").Sort Key1:=Range("E1"), Order1:=xlAscending, Key2:=Range("A1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("A1").Select
Sheets("TimeReg").Select
myLen = Len(fName)
i = 0
cnt = 0
For i = myLen To 1 Step -1
If cnt > 0 Then
str = Right(fName, myLen - i + 1)
Exit For
End If
If Mid(fName, i - 1, 1) = "\" Then
cnt = cnt + 1
End If
Next i
If str <> "" Then
str = Left(str, Len(str) - 4)
str = Right(str, Len(str) - 1)
End If
Range("A6") = str
Range("A8").Select
ActiveSheet.Paste
Range("A8").Select

Columns("A:E").AutoFit

Sheets("TimeReg").Select
Range("A6:G6").Select
Range(Selection, Selection.End(xlDown)).Select
myRange = Selection.Address
ActiveSheet.PageSetup.PrintArea = myRange

Range("A8").Select

End Sub
This line:
Col = UBound(Split(Application.Index(Data, 1, 0), ";"))
trigger an error if these lines are not there:
Sheets("DataKopi").Select
Range("A1").Select I've also tried putting 'Select' lines together in 1 line like this:
Sheets("DataKopi").Range("A1").Select but that triggers an error in that line.

Any advice is welcome!

[mdmackillop]

Code can be written to run on the active sheet or to make changes on other sheets(or even workbooks).
The first thing to look at is how the code is triggered. If by a button on the sheet or sheet event code, you don't need to qualify the location of cells etc.
so Cells(1,1) = 2 will set that value on the sheet. If you need to set values elsewhere then Sheets(2).Cells(1,1) = Cells(1,1) will do this.
If your code is triggered from a toolbar button or menu item, any sheet might be active. You basically have 2 choices.
1. Activate the sheet as in Sheets(1).Activate the run the code.
2. Qualify all references within the code to the particular sheet, as in
With Sheets(1)
.Cells(1,1) = 2
.cells(2,1).resize(10)=20
End With.

If your code involves working with multiple sheets, it is best to set a variable to refer to each and qualify every reference so you don't lose your way.
Set WS1 = Sheets(1)
Set WS2 = Sheets(2)
Set WS3 = Sheets("WhateverName")

WS3.Cells(1,1) = WS1.Cells(1,1) + WS2.Cells(1,1)

and so on.


Sheets("DataKopi").Select
Range("A1").Select

A sheet must be active before you select a cell. You cannot do both on one line. (I prefer Activate for sheets)
You can, however use GoTo Application.GoTo WS1.Cells(1.1)

In the code above, you would need to Select (or Activate) the sheet, but selecting the cell is not required.

The only thing I recall selection is required for is to Freeze Panes.

[mdmackillop]

Code can be written to run on the active sheet or to make changes on other sheets(or even workbooks).
The first thing to look at is how the code is triggered. If by a button on the sheet or sheet event code, you don't need to qualify the location of cells etc.
so Cells(1,1) = 2 will set that value on the sheet. If you need to set values elsewhere then Sheets(2).Cells(1,1) = Cells(1,1) will do this.
If your code is triggered from a toolbar button or menu item, any sheet might be active. You basically have 2 choices.
1. Activate the sheet as in Sheets(1).Activate the run the code.
2. Qualify all references within the code to the particular sheet, as in
With Sheets(1)
.Cells(1,1) = 2
.cells(2,1).resize(10)=20
End With.

If your code involves working with multiple sheets, it is best to set a variable to refer to each and qualify every reference so you don't lose your way.
Set WS1 = Sheets(1)
Set WS2 = Sheets(2)
Set WS3 = Sheets("WhateverName")

WS3.Cells(1,1) = WS1.Cells(1,1) + WS2.Cells(1,1)

and so on.


Sheets("DataKopi").Select
Range("A1").Select

A sheet must be active before you select a cell. You cannot do both on one line. (I prefer Activate for sheets)
You can, however use GoTo Application.GoTo WS1.Cells(1.1)

In the code above, you would need to Select (or Activate) the sheet, but selecting the cell is not required.

The only thing I recall selection is required for is to Freeze Panes.