Append last rows from csv file to Master xlsx file based on csv timestamp

UseLessFuel

New Member
Joined
Dec 22, 2012
Messages
37
Hi.
I occasionaly download a .csv file which contains exactly one year of 1-minute interval data, held in 8 columns (A to H) and copy the data that I do not already have into a Master .xlsx file. The csv data looks like this:

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]Timestamp[/TD]
[TD]Z1[/TD]
[TD]Z2[/TD]
[TD]Out[/TD]
[TD]Flo[/TD]
[TD]EnC[/TD]
[TD]Enp[/TD]
[TD]OpMo[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]09/05/2017 14:50
[/TD]
[TD]17[/TD]
[TD]18[/TD]
[TD]10[/TD]
[TD]30[/TD]
[TD]8[/TD]
[TD]24[/TD]
[TD]water[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]09/05/2017 14:51[/TD]
[TD]17[/TD]
[TD]17[/TD]
[TD]10[/TD]
[TD]28[/TD]
[TD]9[/TD]
[TD]27[/TD]
[TD]water[/TD]
[/TR]
</tbody>[/TABLE]

The Master .xlsx file looks the same (same variables in same columns) but I only need to append the latest data (based on the timestamp) from the csv file into the xlsx file, which is typically the last 43,000 rows of the csv data, at a time.

I was kindly provided with VBA code (below) which has worked, but I think the loop takes too long to execute when there is a large number of rows to copy. Does anyone know of a more efficient way to append only the latest csv data into an xlsx file?

'Appends new data to Master files. You need to have the Master file open
'as well as the downloaded csv file
'

Sub Append()

Dim curworkbook As Workbook
Dim curworksheet As Worksheet
Dim wb As Workbook
Dim ws As Worksheet
Dim Curlastrow As Long
Dim CSVlastrow As Long
Curlastrow = Cells(Rows.Count, 1).End(xlUp).Row
'
'Copy the filename of the Workbook,and overwrite SH005 Trial VBA.xlsx, below
'

Set curworkbook = Workbooks("SH005 Trial VBA.xlsx")
'
'Copy the name of the Worksheet by double clicking the worksheet tab and pressing Ctrl C.
'Now paste it on top of Master data, below
'

Set curworksheet = Worksheets("Master data")
'
'You should not have to change the Workbook and Worksheet filenames below as
'they are all the same when you first download the csv
'

Set wb = Workbooks("CSVReport.csv")
Set ws = wb.Worksheets("CSVReport")
CSVlastrow = ws.Range("A" & Rows.Count).End(xlUp).Row
maxdate = Application.WorksheetFunction.Max(Range(Cells(2, 1), Cells(Curlastrow, 1)))
For i = 2 To CSVlastrow
If ws.Cells(i, 1).Value > maxdate Then
ws.Cells(i, 1).EntireRow.Copy Destination:=curworksheet.Cells(Curlastrow + 1, 1)
Curlastrow = Curlastrow + 1
End If
Next i
End Sub
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Forum statistics

Threads
1,223,886
Messages
6,175,198
Members
452,616
Latest member
intern444

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top