Search code examples
vbadatetextcopypaste

Stop VBA from changing text to date when copy/paste


I want to copy some texts from a sheet to another. For example: 01/02/2021 . However VBA automatically convert it to 2020/01/02. How can I stop it? The following codes didn't work.

Example1:

sheet_1.Range("A1:A" & sheet1.Cells(1, 1).CurrentRegion.End(xlDown).row).Copy
ws.Range("start").PasteSpecial xlPasteValues 
ws.Range("start").PasteSpecial xlPasteFormats

Example2:

sheet_1.Range("A1:A" & sheet1.Cells(1, 1).CurrentRegion.End(xlDown).row).Copy
    ws.Range("start").PasteSpecial xlPasteFormulasAndNumberFormats

Example3:

sheet_1.Range("A1:A" & sheet1.Cells(1, 1).CurrentRegion.End(xlDown).row).Copy
    ws.Range("start").Paste xlPaste Format:="Text" 'This causes an error

Solution

  • Please, try the next code. It will extract the date from the (pseudo) xls file and place it in the first column of the active sheet. Correctly formatted as date:

    Sub openXLSAsTextExtractDate()
       Dim sh As Worksheet, arrTXT, arrLine, arrD, arrDate, fileToOpen As String, i As Long, k As Long
       
       Set sh = ActiveSheet 'use here the sheet you need
       fileToOpen = "xls file full name" 'use here the full name of the saved xls file
       'put the file content in an array splitting the read text by end of line (vbCrLf):
       arrTXT = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(fileToOpen, 1).ReadAll, vbCrLf)
       ReDim arrDate(UBound(arrTXT))          'redim the array where the date will be kept, to have enough space for all the date values
       For i = 39 To UBound(arrTXT) - 1       'iterate between the array elements, starting from the row where date data starts
            arrLine = Split(arrTXT(i), vbTab) 'split the line by vbTab
            arrD = Split(arrLine(0), "/")     'split the first line element (the date) by "/"
            arrDate(k) = DateSerial(arrD(2), arrD(1), arrD(0)): k = k + 1 'properely format as date and fill the arrDate elements
        Next i
        ReDim Preserve arrDate(k - 1)         'keep only the array elements keeping data
        With sh.Range("A1").Resize(UBound(arrDate) + 1, 1)
            .value = Application.Transpose(arrDate)  'drop the array content
            .NumberFormat = "dd/mm/yyyy"             'format the column where the date have been dropped
        End With
    End Sub
    

    Edited:

    You did not say anything...

    So, I made a code returning the whole table (in the active sheet). Please, test it. It will take only some seconds:

    Sub openXLSAsText()
       Dim sh As Worksheet, arrTXT, arrLine, arrD, arrData, fileToOpen As String, i As Long, j As Long, k As Long
       
       Set sh = ActiveSheet 'use here the sheet you need
       fileToOpen =  "xls file full name" 'use here the full name of the saved xls file
       'put the file content in an array splitting the read text by end of line (vbCrLf):
       arrTXT = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(fileToOpen, 1).ReadAll, vbCrLf)
    
       ReDim arrData(1 To 10, 1 To UBound(arrTXT))  'redim the array where the date will be kept, to have enough space for all the date values
       For i = 38 To UBound(arrTXT) - 1             'iterate between the array elements, starting from the row where table header starts
            arrLine = Split(arrTXT(i), vbTab)       'split the line by vbTab
            k = k + 1                               'increment the k variable (which will become the table row)
            For j = 0 To 9
                If j = 0 And k > 1 Then
                    arrD = Split(arrLine(j), "/")   'split the first line element (the date) by "/"
                    arrData(j + 1, k) = DateSerial(arrD(2), arrD(1), arrD(0)) 'propperely format as date and fill the arrDate elements
                ElseIf j = 2 Or j = 3 Then
                    arrData(j + 1, k) = Replace(arrLine(j), ",", ".")  'correct the format for columns 3 and four (replace comma with dot)
                Else
                     arrData(j + 1, k) = arrLine(j)                    'put the rest of the column, not processed...
                End If
            Next j
        Next i
        ReDim Preserve arrData(1 To 10, 1 To k)      'keep only the array elements with data
        With sh.Range("A1").Resize(UBound(arrData, 2), UBound(arrData))
            .value = Application.Transpose(arrData)  'drop the array content
            .EntireColumn.AutoFit                    'autofit columns
            .Columns(1).NumberFormat = "dd/mm/yyyy"  'format the first column
        End With
        MsgBox "Ready..."
    End Sub