PDA

View Full Version : [SOLVED] vba to copy selection of csv file to Workbook



Fergus
03-14-2005, 09:34 PM
I have searched here and Mrexcel but cannot find a similar problem and being a newbie at vba I am tearing my hair out.

My problem: I download a csv file from Yahoo Finance, which will change at each download. I also maintain an Excel Workbook of historical data. I am trying to write a macro to automatically update the historical data workbook by copying the latest data from the csv file. The earliest date in the csv file may be somewhat earlier than the last date in the historical data file.

So far I have managed to get the macro, which is in the historical data workbook, to open the csv file and to locate the row in the csv file corresponding to the last row of data in the historical data file, but for the life of me I cannot get it to copy subsequent rows of data, up to the latest date, into the historical data file.

Can anyone please help? :help

My code so far looks like this:


Public Sub Update()
Dim Lastrow As Long, Nextrow As Long
Dim File_name As String, Half_name As String, Searchname As String, stpt As String
Dim Update_Data_File As String, lastquotedate As String
Dim rng As Range, rngstart As Range
Dim Lastdate As Date, Latestdate As Date
Dim endpos As Variant
Dim wb As Workbook
Application.ScreenUpdating = False
'//Determine last row of historical data file (this workbook sheet1)
Lastrow = Range("A65536").End(xlUp).Row
Nextrow = Lastrow + 1
'//Determine date of last historical data entry
Set rng = Range("A" & Lastrow, "C" & Lastrow)
Lastdate = rng.Cells(1, 3).Value
'//Determine path name for finding & opening downloaded csv data file
'//which will have been automatically saved to the same file folder as the historical data workbook
File_name = ActiveWorkbook.FullName
Searchname = ActiveWorkbook.Name
endpos = InStr(1, File_name, Searchname, 1)
endpos = endpos - 1
Half_name = Left(File_name, endpos)
'//Locate, open & activate downloaded csv data file
Update_Data_File = Half_name & "Update_^FTSE.csv"
Workbooks.Open (Update_Data_File)
'//Format dates in Column A of csv file
ActiveSheet.Columns("A").NumberFormat = "d-mmm-yy"
'//Determine date of last price recorded in historical data workbook
Set rng = ActiveSheet.Range("A2,A2")
lastquotedate = rng.Cells(1, 1).Value
Latestdate = DateValue(lastquotedate)
'// Locate position of last price in csv file
Set rng = ActiveSheet.Range("A1:A65536")
Finddate rng, Lastdate, stpt
'// Copy later data from csv file
Set rngstart = Range(stpt)
ActiveSheet.Range(rngstart).EntireRow.Copy _
Destination:=Workbook.ThisWorkbook("table").Range("C" & Lastrow, "G" & Lastrow).Offset(1, 0) '<~~ Not working!
Application.ScreenUpdating = True
End Sub

Private Sub Finddate(r As Range, target As Variant, startpoint As String)
Dim c As Range
Set c = r.Find(target)
If c Is Nothing Then
MsgBox target & " was not found"
Else
startpoint = c.Address
End If
End Sub

acw
03-15-2005, 10:33 PM
Hi

you will have to change the lines


Set rngstart = Range(stpt) ActiveSheet.Range(rngstart).EntireRow.Copy _ Destination:=Workbook.ThisWorkbook("table").Range("C" & Lastrow, "G" & Lastrow).Offset(1, 0)

to be more like


Range(Range(stpt).Offset(1, 0).Address, Range("a65536").End(xlUp).Address).EntireRow.Copy _
Destination:=Workbooks("book1").Sheets("sheet1").Range("A" & Nextrow)

Some comments

1) stpt will give you the starting point of the matching data for the last entry in your existing file. You will have to offset to get the new data.

2) You will have to copy to the end of the new data

3) You have already established the next row for output (nextrow) so you may as well use it

4) As you are copying an entire row, you will have to output in column A

5) If I read the code correctly, the data you want will be 2 columns to the left of where you want it.

6) If 5, then it may pay to only copy the required range rather than the entire row (C:G perhaps). You can then output directly to column C

7) You will have to modify the destination workbook / sheets etc as I have this set for my testing file.

HTH

Tony

Fergus
03-16-2005, 12:53 AM
Hi Tony and thank you for your reply. I tried your suggestion but got an error message Run-time error '13' Type mismatch. Is this because stpt is Dim'd as String? When I step through the code stpt is correctly returning the starting point of the matching data as, say "$A$16", can this be used in the Range statement?

Your assumption that I don't need to copy the whole row is correct. What I need to copy is cols A to E from the csv file into cols C to G of my historical data file. To make life more complicated, in the csv file the latest date is on row A2, so it needs to copy from say row 16 up to row 2 in cols A to E of the csv file into say row 565 (nextrow) down to row 579 in cols C to G of the historical data file.

I noticed that some of my comments in my macro were misleading so I have changed them. I have also added a bit to close the csv file if it was open at the start, to avoid confusion if it tried to open it again further down.

A copy of the present version is shown below, with your latest suggestion still on it in red. If you have time, any more help would be most gratefully received. If it would help I could upload (or email) the whole workbook and csv file.

What I intend to do, once I can get this working, is to duplicate it into several workbooks for different indices and stock records. I already have (with help from Ivan Molo on Mrexcel) a macro that automatically downloads any stock csv file from Yahoo Finance, so this is the second stage of the exercise.

Many thanks
Fergus


Public Sub Update()
Dim Lastrow As Long, Nextrow As Long
Dim File_name As String, Half_name As String, Searchname As String, stpt As String
Dim Update_Data_File As String, lastquotedate As String
Dim rng As Range, rngstart As Range
Dim Lastdate As Date, Latestdate As Date
Dim endpos As Variant
Dim wb As Workbook
Application.ScreenUpdating = False
'// Close open csv file
For Each wb In Workbooks
If wb.Name = "Update_^FTSE.csv" Then
wb.Close savechanges:=False
End If
Next wb
'//Determine last row of historical data file (this workbook sheet1)
Lastrow = Range("A65536").End(xlUp).Row
Nextrow = Lastrow + 1
'//Determine date of last historical data entry
Set rng = Range("A" & Lastrow, "C" & Lastrow)
Lastdate = rng.Cells(1, 3).Value
'//Determine path name for finding & opening downloaded csv data file
'//which will have been automatically saved to the same file folder as the historical data workbook
File_name = ActiveWorkbook.FullName
Searchname = ActiveWorkbook.Name
endpos = InStr(1, File_name, Searchname, 1)
endpos = endpos - 1
Half_name = Left(File_name, endpos)
'//Locate, open & activate downloaded csv data file
Update_Data_File = Half_name & "Update_^FTSE.csv"
Workbooks.Open (Update_Data_File)
'//Format dates in Column A of csv file
ActiveSheet.Columns("A").NumberFormat = "d-mmm-yy"
'//Determine date of most up-to-date price in csv file
Set rng = ActiveSheet.Range("A2,A2")
lastquotedate = rng.Cells(1, 1).Value
Latestdate = DateValue(lastquotedate)
'// Locate corresponding position in csv file of last price in historical data workbook
Set rng = ActiveSheet.Range("A1:A65536")
Finddate rng, Lastdate, stpt
'// Copy later data from csv file
Range(Range(stpt).Offset(1, 0).Address, Range("a65536").End(xlUp).Address).EntireRow.Copy _
Destination:=Workbooks(ThisWorkbook).Sheets("table").Range("A" & Nextrow)
'Set rngstart = Range(stpt)
'ActiveSheet.Range(rngstart).EntireRow.Copy _
'Destination:=Workbook.ThisWorkbook("table").Range("C" & Lastrow, "G" & Lastrow).Offset(1, 0)
Application.ScreenUpdating = True
End Sub
Private Sub Finddate(r As Range, target As Variant, startpoint As String)
Dim c As Range
Set c = r.Find(target)
If c Is Nothing Then
MsgBox target & " was not found"
Else
startpoint = c.Address
End If
End Sub

Paleo
03-16-2005, 06:09 AM
You must change this:



Dim stpt As String


to



Dim stpt As Range

acw
03-16-2005, 03:54 PM
Fergus

try changing

Range(Range(stpt).Offset(1, 0).Address, Range("a65536").End(xlUp).Address).EntireRow.Copy _
Destination:=Workbooks(ThisWorkbook.Name).Sheets("table").Range("A" & Nextrow)

to


Range(Range(stpt).Offset(1, 0).Address, Range("a65536").End(xlUp).Address).EntireRow.Copy _
Destination:=Workbooks(ThisWorkbook).Sheets("table").Range("A" & Nextrow)

or


Range(Range(stpt).Offset(1, 0).Address, Range("a65536").End(xlUp).Address).EntireRow.Copy _
Destination:=ThisWorkbook.Sheets("table").Range("A" & Nextrow)

Tony

Zack Barresse
03-16-2005, 04:20 PM
Hi Tony! Great to see you here! Your expertise is greatly appreciated!

stuff I added them to your posts. See how they make your code look? :)

Hope to see ya 'round! :yes

Fergus
03-17-2005, 02:22 AM
Me again Tony,


I tried your suggestions, which gave me a run-time error, and have since spent hours on this and referring to the Help files. I have tried to set it up so that it will, once I have added a Do Loop, copy one row at a time. So far I have got it to do the first copy and paste into the right row in the right position. Trouble is, the row it's copying from is in ThisWorkBook NOT the csv file !! No matter what I try to do to first activate the csv file so that it starts the copy from there.

The row in This WorkBook that it is copying from is the correct row, it's just on the wrong sheet :banghead: I'll copy below the last few lines of my code, everything above is the same as before. If you have any more time to look at this I would be most grateful.


'// Locate corresponding position in csv file of last price in historical data workbook
Set rng = ActiveSheet.Range("A1:A65536")
Finddate rng, Lastdate, stpt
'// Activate csv file and set start range for copy
Workbooks("Update_^FTSE.csv").Activate
Set rngstart = Range(Range(stpt).Offset(-1, 0).Address, Range(stpt).Offset(-1, 5).Address)
'// Copy later data from csv file
rngstart.Copy _
Destination:=Workbooks(ThisWorkbook.Name).Sheets("table").Range("C" & Nextrow)
Application.ScreenUpdating = True
End Sub

acw
03-17-2005, 09:45 PM
Fergus

As per our offline conversation, here is the final code.

Tony


Public Sub Update()
Dim Lastrow As Long, Nextrow As Long
Dim File_name As String, Half_name As String, Searchname As String, stpt As String
Dim lastquotedate As String, Update_Data_File As String
Dim csv_file As Workbook, wb As Workbook
Dim rng As Range, rngstart As Range
Dim Lastdate As Date, Latestdate As Date
Dim endpos As Variant
Application.ScreenUpdating = False
'// Close open csv file
For Each wb In Workbooks
If wb.Name = "Update_^FTSE.csv" Then
wb.Close savechanges:=False
End If
Next wb
'//Determine last row of historical data file (this workbook sheet1)
Lastrow = Range("A65536").End(xlUp).Row
Nextrow = Lastrow + 1
'//Determine date of last historical data entry
Set rng = Range("A" & Lastrow, "C" & Lastrow)
Lastdate = rng.Cells(1, 3).Value
'//Determine path name for finding & opening downloaded csv data file
'//which will have been automatically saved to the same file folder as the historical data workbook
File_name = ActiveWorkbook.FullName
Searchname = ActiveWorkbook.Name
endpos = InStr(1, File_name, Searchname, 1)
endpos = endpos - 1
Half_name = Left(File_name, endpos)
'//Locate, open & activate downloaded csv data file
Update_Data_File = Half_name & "Update_^FTSE.csv" 'Full path and name of csv file
Workbooks.Open (Update_Data_File)
'//Format dates in Column A of csv file
ActiveSheet.Columns("A").NumberFormat = "d-mmm-yy"
'//Determine date of most up-to-date price in csv file
Set rng = ActiveSheet.Range("A2,A2")
lastquotedate = rng.Cells(1, 1).Value
Latestdate = DateValue(lastquotedate)
'// Locate corresponding position in csv file of last price in historical data workbook
Set rng = ActiveSheet.Range("A1:A65536")
Finddate rng, Lastdate, stpt
'// Activate csv file and set start range for copy
Workbooks("Update_^FTSE.csv").Activate
'Set rngstart = Range(Range(stpt).Offset(-1, 0).Address, Range(stpt).Offset(-1, 5).Address)
'// Copy later data from csv file
'rngstart.Copy _
'Destination:=Workbooks(ThisWorkbook.Name).Sheets("table").Range("C" & Nextrow)
Range(stpt).Offset(-1, 0).Select
While ActiveCell.Row > 1
Range(ActiveCell, ActiveCell.Offset(0, 4)).Copy Destination:=Workbooks(ThisWorkbook.Name).Sheets("table").Range("C" & Nextrow)
Nextrow = Nextrow + 1
ActiveCell.Offset(-1, 0).Select
Wend
Workbooks(ThisWorkbook.Name).Activate
Sheets("table").Select
'// Complete formulas for new data
Range("A65536").End(xlUp).Select
Range(ActiveCell, ActiveCell.Offset(0, 1)).Select
Selection.AutoFill Destination:=Range(ActiveCell, Cells(Nextrow - 1, 2))
Range("H65536").End(xlUp).Select
Range(ActiveCell, ActiveCell.Offset(0, 7)).Select
Selection.AutoFill Destination:=Range(ActiveCell, Cells(Nextrow - 1, 15))
Application.ScreenUpdating = True
End Sub