How can I use VBA to select data for a date range from an Excel file and paste it in another workbook?

[Davao_Danny]

Hi everyone.

I've been using the following code to import a given number of days' opening/closing share prices for companies to Excel (using Yahoo's business website).

Each company has got its own worksheet in a workbook, and each worksheet's name is the company name followed by its Yahoo trading code, e.g. BARCLAYS (BARC.L).

Sub Import()
'ímport
Dim lngIndex As Long
ReDim vntNames(1 To ActiveWindow.SelectedSheets.Count) As Variant
For lngIndex = 1 To ActiveWindow.SelectedSheets.Count
vntNames(lngIndex) = ActiveWindow.SelectedSheets(lngIndex).Name
Next
For lngIndex = 1 To UBound(vntNames)
Sheets(vntNames(lngIndex)).Select True
Dim Code As String
Dim StartMonth As String
Dim StartDay As String
Dim StartYear As String
Dim EndMonth As String
Dim EndDay As String
Dim EndYear As String
With ActiveSheet
Code = Replace(Mid(.Name, InStr(1, .Name, "(") + 1, 255), ")", "")
StartMonth = Range("AA36").Value
StartDay = Range("W6").Value
StartYear = Range("Y6").Value
EndMonth = Range("AA37").Value
EndDay = Range("W7").Value
EndYear = Range("Y7").Value
End With
ActiveSheet.Calculate
ActiveWorkbook.FollowHyperlink Address:="http://ichart.yahoo.com/table.csv?s=" & Code & "&a=" & StartMonth & "&b=" & StartDay & "&c=" & StartYear & "&d=" & EndMonth & "&e=" & EndDay & "&f=" & EndYear & "&g=d&ignore=.csv", NewWindow:=True
Workbooks(2).Activate
Columns("A:E").Select
Selection.Copy
Workbooks(1).Activate
Range("A:E").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:A").ColumnWidth = 10
Workbooks(2).Activate
ActiveWindow.Close
Workbooks(1).Activate
Next
End Sub

I am studying past data, going back several years, and I've been downloading three months worth of data leading up to every trading day, for each of 100 companies (which takes up to around 30 mins for each batch).

Instead of wasting a lot of time frequently downloading data, I can save several years worth of company data, e.g. http://ichart.yahoo.com/table.csv?s=BARC.L&a=00&b=1&c=2008&d=02&e=5&f=2010&g=d&ignore=.csv obtains data from 01 January 2008 to 05 March 2010 (which is saved as a CSV Excel file).

Using this example, and with the data file's name being the same as its corresponding worksheet in my workbook, i.e. BARCLAYS (BARC.L), I'm looking for a macro that will look down column A of the data file for today's date (the date that the computer's clock is set at) and select columns A:E for the rows from today's date down to the date 91 days earlier.

For example, if the computer date is set at 04 March 2010, columns A:E should be selected for the rows starting from the row 04 March 2010 down to the row for 03 December 2009.

If, due to it landing on a weekend or a holiday, the date 91 days before the current computer clock date is not included in the data, rows should be selected down to the first date after the excluded dates. For example, if the computer clock is set at 26 March 2009, the date 91 days earlier would be 25 December 2008, so the next available row would be for the date 29 December 2008.

The selected rows of data, from columns A to E of the data file should then be pasted into columns A to E of the worksheet with the saje name in my workbook, starting from cell A2 (cells A1 to E1 contains headers).

Grateful if anyone can me with this. I'm sure it's very simple for someone who knows more about VBA than I do!

Thanks in advance.
Danny

 

[ravishankar]

HI
Try these codes

Dim x As Long
x = Range("A" & Rows.Count).End(xlUp).Row
Range("a1:J" & x).AutoFilter Field:=1, Criteria1:=">=" & Date - 91, Operator:=xlAnd, _
        Criteria2:="<=" & Date 
     Range("a1:J" & x).SpecialCells(xlCellTypeVisible).Copy
    workbooks("summary.xls").Sheets("sheet1"). Range("A1").PasteSpecial
Range("A1:J" & x).AutoFilter
MsgBox "Complete"

It filters data for previous 91 days and copies it to book called summry
Ravi

 

[Davao_Danny]

Hi Ravi. Thanks for your very quick and useful reply.

The code you gave works well for a specified source and destination.
Now I want to make the macro non-specific.

For examlpe, the source workbook contains several worksheets named ABC (12.L), DEF (34.L), GHI (56.L), JKL (78.L), etc, and the worksheets in the destination workbook are identically named.

Using only a single code, I want the selected data to be pasted to the worksheet in the destination workbook with the same name as whichever worksheet is selected in the source workbook.

I'm guessing that, to do this, I might need to use Replace(Mid(.Name, InStr(1, .Name, "(") + 1, 255), ")", ""), as per the macro mentioned in my initial post (which admitedly was not written by me!)

Grateful if you could help me with modification.

Best regards,
Danny

 

[ravishankar]

Hi
Try this modification.

Sub danny()
Dim x As Long, a As Long
Dim b As String
For a = 1 To Sheets.Count
b = Worksheets(a).Name
x = Worksheets(a).Range("A" & Rows.Count).End(xlUp).Row
Worksheets(a).Range("a1:J" & x).AutoFilter Field:=1, Criteria1:=">=" & Date - 91, Operator:=xlAnd, _
        Criteria2:="<=" & Date
     Worksheets(a).Range("a1:J" & x).SpecialCells(xlCellTypeVisible).Copy
    Workbooks("summary.xls").Sheets(b).Range("A1").PasteSpecial
Worksheets(a).Range("A1:J" & x).AutoFilter
Next a
MsgBox "Complete"
End Sub

Ravi

 

[Davao_Danny]

Thank you for your time and effort, Ravi. Your modified code works perfectly for me.

Cheers!

Danny

 

[Davao_Danny]

Hi Ravi. This is weird...

The code you gave me works perfectly well on my comapny's desktop (using Windows XP and Excel 2003); but when I try to run it on my laptop (using Windows Vista and Excel 2003), it gives "run-time error '9': Subscript out of range".

Do you think it's an issue with Vista? As far as I can see, all Excel settings are the same for both computers.

Danny

 

[Davao_Danny]

I forgot to mention that I adjusted your code slightly to suit my needs... instead of specifying the destination workbook's name, I made it "Worbooks(2)" because it's not always the same file.
The code worked fine with my Windows XP desktop.

Now, when the Run-time error occurs, and I select debug, the line "Workbooks(2).Sheets(b).Range("A1").PasteSpecial" is highlighted.

Sub export_from_data_lists()
Dim x As Long, a As Long
Dim b As String
For a = 1 To Sheets.Count
b = Worksheets(a).Name
x = Worksheets(a).Range("A" & Rows.Count).End(xlUp).Row
Worksheets(a).Range("A1:E" & x).AutoFilter Field:=1, Criteria1:=">=" & Date - 91, Operator:=xlAnd, _
Criteria2:="<=" & Date
Worksheets(a).Range("A1:E" & x).SpecialCells(xlCellTypeVisible).Copy
Workbooks(2).Sheets(b).Range("A1").PasteSpecial
Worksheets(a).Range("A1:E" & x).AutoFilter
Next a
End Sub

Danny

 

[ravishankar]

Hi
You need to specify the workbook name as I did in my code

Workbooks("summary.xls").Sheets(b).Range("A1").PasteSpecial

if destination file is not summary.xls, change the filename to where you wish to paste it. this explains why you are getting subscript out of range error
ravi

 

[Davao_Danny]

The code works fine without specifying the destination workbook's name (using Workbooks(2) instead).

The only problem seems to be when I try to run it on Vista.

I've tried adding the lines Workbooks(2).Activate before Workbooks(2).Sheets(b).Range("A1").PasteSpecial, and Workbooks(1).Activate before Worksheets(a).Range("A1:E" & x).AutoFilter.
Again, this works fine with Windows XP, but gives the same error with Windows Vista.

I'm considering formatting my laptop, and installing a copy of Windows XP.

Danny