Extracting data from various excel reports using VBA

[staffordalex]

Hi,

I'm trying to pull data from various excel spreadsheets into one summary report in a grid (see example in attachment).

Each spreadsheet is held within a folder, named as a date such as 2008-10-14, 2008-10-21 etc. I have so managed to write some VBA so that when a date is selected at the top of my summary report, the date of the corresponding folder is inserted into a link which points to one report within the folder and pulls back one piece of data.

Here is my code so far:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim firstpart As String, secondpart As String, solutions_design_overall_status As String
firstpart = "sharepointsite/Meetings/"
secondpart = "/[Vauxhall Report.xls]Worksheet1'!D11"
If Not Intersect(Target, Range("C6")) Is Nothing Then
Application.EnableEvents = False
Cells.Hyperlinks.Add anchor:=Range("V11"), Address:=firstpart & Format(Target + 4, "yyyy-mm-dd") & _
secondpart, TextToDisplay:=firstpart & Format(Target + 4, "yyyy-mm-dd") & secondpart _

vauxhall_overall_status = "=" & firstpart & Format(Target + 4, "yyyy-mm-dd") & secondpart _
Range("B2").Value = vauxhall_overall_status
Application.EnableEvents = True
End If
End Sub


At the moment all this VBA code is doing is taking the date from the summary report, creating a link which includes the correspending date for the folder to look in, and pulls the overall status data from the Vauxhall report.

How do I write a loop so that once a date is selected from the summary report, it looks within the corresponding folder on the sharepoint site, as it is doing at the moment, and then pulls data from the Vauxhall report, Ford report, Fiat report etc. for each of the headings along the top of the grid (see attachment)???

Many Thanks,
Alex

[GTO]

Hello staffordalex,

If I recall correctly, I saved/opened the example wb while at another location, and couldn't get it to step-thru far enough to see what was happening or what you were trying to do. Respects to keeping private info private, could you supply an example workbook that is operational enough to see where the path is supposed to be heading?

I should have prefaced that with advising that there are certainly others here who may better discern your question; just thought to mention, as I noted no responses thus far...

Hope this helps,

Mark

[staffordalex]

Mark,

I'll try and explain what I'm hoping for the VBA code to achieve.

I've got six reports, which all rate a certain area (lets say for example these are different car makes) in terms of set criteria. The criteria is for example, overall status (Red, Amber or Green), Teamwork (Red, Amber or Green), Communication (Red, Amber or Green) etc.

These six reports are submitted to me each week and I've got a summary sheet which displays the ratings from each area. At the moment I'm simply copying the ratings from each report into the summary report manually.

I'd like the VBA code, which is linked to the summary report, to automatically recognise the date that is selected from the top of the summary report, and then go and pull each RAG status (Red, Amber or Green) from each report.

Hope this helps.

Thanks,
Alex

[Bob Phillips]

See if this, untested code, helps



Private Sub GetData()
Dim LookupDate As Date

LookupDate = Range("C6").Value

Call GetData(ThisWorkbook, LookupDate, "Vauxhall")
Call GetData(ThisWorkbook, LookupDate, "Fiat")
Call GetData(ThisWorkbook, LookupDate, "Ford")
'etc
End Sub

Private Sub GetData(wb As Workbook, LookupDate As Date, Maker As String)
Const ROOT_FOLDER As String = "sharepointsite/Meetings/"
Dim LastRow As Long
Dim NextRow As Long

With wb.Worksheets(1)

NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

Workbooks.Open ROOT_FOLDER & Format(LookupDate, "yyyy-mm-dd") & Application.PathSeparator & Maker & " Report.xls"
With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Rows(2).Resize(LastRow - 1).Copy wb.Worksheets(1).Cells(NextRow, "A")
ActiveWorkbook.Close savechanges:=False
End Sub

[staffordalex]

xld,

thanks for taking the time out to help me!

I've put the code in, and changed the sharepoint address, names etc. however I'm coming up with a compile error: ambiguous name detected GetData.

Any help?

Cheers,
Alex

[Bob Phillips]

Sorry, meant to use another name




Private Sub GetData()
Dim LookupDate As Date

LookupDate = Range("C6").Value

Call GetWBData(ThisWorkbook, LookupDate, "Vauxhall")
Call GetWBData(ThisWorkbook, LookupDate, "Fiat")
Call GetWBData(ThisWorkbook, LookupDate, "Ford")
'etc
End Sub

Private Sub GetWBData(wb As Workbook, LookupDate As Date, Maker As String)
Const ROOT_FOLDER As String = "sharepointsite/Meetings/"
Dim LastRow As Long
Dim NextRow As Long

With wb.Worksheets(1)

NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

Workbooks.Open ROOT_FOLDER & Format(LookupDate, "yyyy-mm-dd") & Application.PathSeparator & Maker & " Report.xls"
With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Rows(2).Resize(LastRow - 1).Copy wb.Worksheets(1).Cells(NextRow, "A")
ActiveWorkbook.Close savechanges:=False
End Sub

[staffordalex]

xld,

thanks, I've done that but I'm now getting the following error:

Run-Time error '438'
Object doesn't support this property or method.

[staffordalex]

xld,

please find enclosed my current code.



Private Sub GetData()
Dim LookupDate As Date

LookupDate = Range("C6").Value

Call GetWorkStreamData((WorkstreamReport), LookupDate, "Vauxhall")
Call GetWorkStreamData((WorkstreamReport), LookupDate, "Ford")
Call GetWorkStreamData((WorkstreamReport), LookupDate, "Fiat")
Call GetWorkStreamData((WorkstreamReport), LookupDate, "VW")
Call GetWorkStreamData((WorkstreamReport), LookupDate, "Honda")
Call GetWorkStreamData((WorkstreamReport), LookupDate, "Toyota")

End Sub

Private Sub GetWorkStreamData(wb As Workbook, LookupDate As Date, WorkStream As String)
Const ROOT_FOLDER As String = "sharepointsite.net/meetings/reports/"
Dim LastRow As Long
Dim NextRow As Long

With wb.Sheets("WorkstreamReport")
NextRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
End With

Workbooks.Open ROOT_FOLDER & Format(LookupDate + 4, "yyyy-mm-dd") & Application.PathSeparator & "Atlas Report to PMT from " & WorkStream

With ActiveSheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

Rows(2).Resize(LastRow - 1).Copy wb.WorkstreamReport.Cells(NextRow, "B")
ActiveWorkbook.Close savechanges:=False

End Sub


as it stands, when I step through the code I get a run-time error '424': object required when I get to Call GetWorkStreamData((WorkstreamReport), LookupDate, "Fiat")

I think its because I'm not declaring GetWorkStreamData in the first sub. How do you do this?

thanks,
alex

[Bob Phillips]

It is more likjely because you are using (WorkstreamReport) in the call. What is that variable and why have you enclosed it in brackets?

[staffordalex]

not too sure, I must have been experimenting....I've changed it back now.
Running the bare bits of the code, step by step, the first error occurs at:



Private Sub GetData()
Dim LookupDate As Date

LookupDate = Range("C6").Value

Call GetWorkStreamData(ThisWorkbook, LookupDate, "Vauxhall")


It says compile errors - expected Sub, Function, or Property.

[Norie]

Remove Call and the parentheses.

GetWorkStreamData ThisWorkbook, LookupDate, "Vauxhall"

[Bob Phillips]

Remove Call and the parentheses.

GetWorkStreamData ThisWorkbook, LookupDate, "Vauxhall"


Totally irrelevant.

[Bob Phillips]

not too sure, I must have been experimenting....I've changed it back now.
Running the bare bits of the code, step by step, the first error occurs at:



Private Sub GetData()
Dim LookupDate As Date

LookupDate = Range("C6").Value

Call GetWorkStreamData(ThisWorkbook, LookupDate, "Vauxhall")


It says compile errors - expected Sub, Function, or Property.

do you have a couple of example workbooks that you can post, sya the master and Vauxhall?

[staffordalex]

Norie (and xld),




GetWorkStreamData ThisWorkbook, LookupDate, "Vauxhall"


seems to have created a bit of progress.
I can now step through the code and get to an error message within the summary report saying that the location the vba code has created is invalid. it feels like its close to working.

as soon as I check OK to that error pop-up, I get a Run-time error '1004' : Application-defined or object-defined error in the Visual Basic window.

any ideas,

cheers,
alex

[Norie]

Totally irrelevant.
:dunno

[staffordalex]

Hi,

I think I'm so close to having this working.
Stepping through the code it makes it all the way until:



Rows(2).Resize(LastRow - 1).Copy wb.WorkstreamReport.Cells(NextRow, "B")


and then I get a run-time error '438' - object doesn't support this property or method. Do I need to change wb.WorkstreamReport to wb.Sheets("WorkstreamReport") or something along those lines????

Here is the full code as it stands:


Private Sub GetData()
Dim LookupDate As Date

LookupDate = Range("C6").Value
GetWorkStreamData ThisWorkbook, LookupDate, "Vauxhall"
GetWorkStreamData ThisWorkbook, LookupDate, "Ford"
GetWorkStreamData ThisWorkbook, LookupDate, "Fiat"
GetWorkStreamData ThisWorkbook, LookupDate, "VW"
GetWorkStreamData ThisWorkbook, LookupDate, "Honda"
GetWorkStreamData ThisWorkbook, LookupDate, "Toyota"

End Sub

Private Sub GetWorkStreamData(wb As Workbook, LookupDate As Date, WorkStream As String)

Const ROOT_FOLDER As String = http://sharepoint.net/meetings/reports/
Dim LastRow As Long
Dim NextRow As Long
With wb.Sheets("WorkstreamReport")
NextRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
End With

Workbooks.Open ROOT_FOLDER & Format(LookupDate + 4, "yyyy-mm-dd") & Application.PathSeparator & " Report to PMT from " & WorkStream & ".xls"

With ActiveSheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

Rows(2).Resize(LastRow - 1).Copy wb.WorkstreamReport.Cells(NextRow, "B")
ActiveWorkbook.Close savechanges:=False

End Sub


Any help would be much appreciated!

thank you!
alex

[staffordalex]

xld,

I've attached the following example workbooks: Report to PMT from Vauxhall and Summary Report.

As you can see, I'm trying to pull a row of data from the vauxhall report and insert it into the summary report grid.

thanks,
alex

[staffordalex]

summary report attached

[staffordalex]

I've made a few adjustments and it nows runs all the way through, however it doesnt seem to be copying any data in.

Is there a problem with my loop? Do I need to specify the range on the summary sheet that I need to copy too?

[rbrhodes]

Hi sa,

I just ran your samples and found a few problems with whats posted here. However you say you;ve adjusted it and it workd except the copy:


This line doesn't specify a sheet. WorkstreamReport is nothing and you're attempting to copy a full row to a partial row = 2 Errors
Rows(2).Resize(LastRow - 1).Copy wb.WorkstreamReport.Cells(NextRow, "B")


Try:

Rows(2).Resize(LastRow - 1).Copy wb.Sheets("WorkstreamReport").Cells(NextRow, "A")


Or rewrite the code to specify Column "B" to Last Column of data.

[staffordalex]

Hi rbrhodes,

Here is my current code:


Private Sub GetData()
Dim LookupDate As Date

LookupDate = Range("C6").Value
GetWorkStreamData ThisWorkbook, LookupDate, "Vauxhall"
GetWorkStreamData ThisWorkbook, LookupDate, "Ford"
GetWorkStreamData ThisWorkbook, LookupDate, "Fiat"
GetWorkStreamData ThisWorkbook, LookupDate, "VW"
GetWorkStreamData ThisWorkbook, LookupDate, "Honda"
GetWorkStreamData ThisWorkbook, LookupDate, "Toyota"

End Sub

Private Sub GetWorkStreamData(wb As Workbook, LookupDate As Date, WorkStream As String)

Const ROOT_FOLDER As String = http://sharepoint.net/meetings/reports/
Dim LastRow As Long
Dim NextRow As Long

With wb.Sheets("WorkstreamReport")
NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

Workbooks.Open ROOT_FOLDER & Format(LookupDate + 4, "yyyy-mm-dd") & Application.PathSeparator & "Report to PMT from " & WorkStream & ".xls"

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

Rows(2).Resize(LastRow - 1).Copy wb.Sheets("WorkstreamReport").Cells(NextRow, "A")
ActiveWorkbook.Close savechanges:=False

End Sub



It opens up the Vauxhall report but doesnt copy any data into the summary report?

Thanks,
Alex

[rbrhodes]

Hi Alex,

You're still using Column A. Change it to B and you'll see results:


With wb.Sheets("WorkstreamReport")

'//This will return 2 if Column is A, Change to B for correct results
NextRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
End With

Workbooks.Open ROOT_FOLDER & Format(LookupDate + 4, "yyyy-mm-dd") & Application.PathSeparator & "Report to PMT from " & WorkStream & ".xls"
With ActiveSheet

'//This will return 1 if Col A, Change to B for correct results
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With