SOLVED

Copy/Paste VBA script

Copper Contributor

Hello, 

 

I have created the VBA script to copy the data from 'New list' to 'Macro_Enabled1' (Please find attached).

It is unfortunately not possible to upload xltm extension file.  What you can do with Macro_Enabled1 for test is to create new module in VBA and copy the script below to it. In the Sheet1 of Macro_Enabled1 create a button 'Copy' and associate it to macro.

 

Problem is that data pasted to 4th column has 'General' value instead of 'Date' as it is in original file (New list). Because of that I have the problems with removing duplicates based on 4th column criteria. 

 

Could you please have a look at the script and find out what is wrong with it? How to adjust it?

 

Kind regards,

Guram

 

Sub Copy()

Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim i As Integer
Dim lastrow As Long
Dim verylastrow As Long


If MsgBox("Please make sure you upload Tableau report", vbOKCancel, "Just checking") = vbOK Then

Application.ScreenUpdating = False

FileToOpen = Application.GetOpenFilename(FileFilter:="Comma Separated Values Files (*.csv),*.csv")

If FileToOpen <> False Then

Set OpenBook = Application.Workbooks.Open(FileToOpen)
lastrow = ThisWorkbook.Worksheets("sheet1").Range("B9000").End(xlUp).Row + 1
OpenBook.Sheets(1).Range("A2", Range("O2").End(xlDown)).Copy ThisWorkbook.Worksheets("sheet1").Range("A" & lastrow)
OpenBook.Close savechanges:=False

End If

End If

verylastrow = ThisWorkbook.Worksheets("sheet1").Range("B9000").End(xlUp).Row
For i = lastrow To verylastrow
Cells(i, 16).Value = Date

Next

Application.ScreenUpdating = True
'Process_Data2()
End Sub

1 Reply
best response confirmed by Guram_Bregadze (Copper Contributor)
Solution

@Guram_Bregadze 

As far as I can tell, the problem occurs when the values in the 4th column have a different date format than your system date format. This will cause Excel to see the values as text instead of as dates. As a workaround, you can convert the text values to dates in the macro.

I replaced the loop in your macro with a single statement for efficiency.

Sub Copy()
    Dim wsh As Worksheet
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim lastrow As Long
    Dim verylastrow As Long

    Application.ScreenUpdating = False

    Set wsh = ThisWorkbook.Worksheets("sheet1")
    If MsgBox("Please make sure you upload Tableau report", vbOKCancel, "Just checking") = vbOK Then
        FileToOpen = Application.GetOpenFilename(FileFilter:="Comma Separated Values Files (*.csv),*.csv")
        If FileToOpen <> False Then
            Set OpenBook = Application.Workbooks.Open(FileToOpen)
            lastrow = wsh.Range("B9000").End(xlUp).Row + 1
            OpenBook.Sheets(1).Range("A2", Range("O2").End(xlDown)).Copy wsh.Range("A" & lastrow)
            OpenBook.Close SaveChanges:=False
        End If
    End If

    verylastrow = wsh.Range("B9000").End(xlUp).Row
    ' Convert text values to dates in column D.
    wsh.Range("D" & lastrow & ":D" & verylastrow).TextToColumns FieldInfo:=Array(1, xlMDYFormat)
    wsh.Range("P" & lastrow & ":P" & verylastrow).Value = Date

    Application.ScreenUpdating = True
    'Process_Data2()
End Sub
1 best response

Accepted Solutions
best response confirmed by Guram_Bregadze (Copper Contributor)
Solution

@Guram_Bregadze 

As far as I can tell, the problem occurs when the values in the 4th column have a different date format than your system date format. This will cause Excel to see the values as text instead of as dates. As a workaround, you can convert the text values to dates in the macro.

I replaced the loop in your macro with a single statement for efficiency.

Sub Copy()
    Dim wsh As Worksheet
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim lastrow As Long
    Dim verylastrow As Long

    Application.ScreenUpdating = False

    Set wsh = ThisWorkbook.Worksheets("sheet1")
    If MsgBox("Please make sure you upload Tableau report", vbOKCancel, "Just checking") = vbOK Then
        FileToOpen = Application.GetOpenFilename(FileFilter:="Comma Separated Values Files (*.csv),*.csv")
        If FileToOpen <> False Then
            Set OpenBook = Application.Workbooks.Open(FileToOpen)
            lastrow = wsh.Range("B9000").End(xlUp).Row + 1
            OpenBook.Sheets(1).Range("A2", Range("O2").End(xlDown)).Copy wsh.Range("A" & lastrow)
            OpenBook.Close SaveChanges:=False
        End If
    End If

    verylastrow = wsh.Range("B9000").End(xlUp).Row
    ' Convert text values to dates in column D.
    wsh.Range("D" & lastrow & ":D" & verylastrow).TextToColumns FieldInfo:=Array(1, xlMDYFormat)
    wsh.Range("P" & lastrow & ":P" & verylastrow).Value = Date

    Application.ScreenUpdating = True
    'Process_Data2()
End Sub

View solution in original post