Extracting data from various excel reports using VBA

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:

[vba]
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
[/vba]

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

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

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

See if this, untested code, helps

[vba]

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
[/vba]

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

Sorry, meant to use another name

[vba]


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
[/vba]

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.

xld,

please find enclosed my current code.

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

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

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:

Code:

---

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.

Remove Call and the parentheses.
[vba]
GetWorkStreamData ThisWorkbook, LookupDate, "Vauxhall"
[/vba]

Quote:

---

Originally Posted by Norie

Remove Call and the parentheses.
[vba]
GetWorkStreamData ThisWorkbook, LookupDate, "Vauxhall"
[/vba]

---

Totally irrelevant.

Quote:

---

Originally Posted by 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:

Code:

---

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?

Norie (and xld),

Code:

---

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

Quote:

---

Originally Posted by xld

Totally irrelevant.

---

:dunno

Hi,

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

Code:

---

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:

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, "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

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

summary report attached

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?

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
[VBA]Rows(2).Resize(LastRow - 1).Copy wb.WorkstreamReport.Cells(NextRow, "B")
[/VBA]

Try:
[VBA]
Rows(2).Resize(LastRow - 1).Copy wb.Sheets("WorkstreamReport").Cells(NextRow, "A")
[/VBA]

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

Hi rbrhodes,

Here is my current code:

[VBA]
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

[/VBA]

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

Thanks,
Alex

Hi Alex,

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

[VBA]
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

[/VBA]