PDA

View Full Version : Extract information from close workbooks



blairt
11-12-2008, 04:21 PM
Hi all,

I am trying to extract information from a sheet in several closed workbooks. The purpose is to summarise a bunch of financial forecasts into one document.

I wrote a program which works, using some info from the KBase. The method involved writing cell information which referenced the closed workbook cell required. But it does it cell by cell.

I need to summarise info from approx 150 cells from 100 workbooks and at the moment, it appears as though each cell reference queries the workbook, and the same workbook will be queried for cell info 150 times before moving on to the next workbook.

I would imagine that it would be alot faster to get all the information required from the workbook with 1 query then move on to the next workbook and do the same. At the moment, the ~150 queries takes about 1 min 10 secs, so for 100 workbooks, will take around 2 hours, thats with the files on a local drive, it is to be used with remote files once complete.

So I am wondering if anyone can tell me a better way? Perhaps using a SQL type query? I am not tip top with SQL so I am not sure if it can solve my problem, if so, i will move my questions to the SQL section, let me know.

Anyway, here is the code:


Sub AlternateSummarise()
'this function summarises all the data

Dim Sws As Worksheet
Dim Lws As Worksheet
Dim Sr As Long, Sc As Long, Lr As Long, Lc As Long
Dim NoFiles As Long
Dim MyCell As Range
Dim Hold As String
Dim Err As Long

Err = 1
Worksheets("Errors").UsedRange.Clear

Call ClearTable

Set Sws = Worksheets("Testing")
Set Lws = Worksheets("All Files")

Sws.Cells(1, 17) = Now()

NoCells = Lws.Cells(1, 4)

Lr = 1
Lc = 3

On Error GoTo ErrorHandling:

'First Column
For Lr = 1 To NoCells

Sws.Cells(6, 17) = Lr / NoCells

For Sr = 14 To 28
For Sc = 13 To 13
If ((Sr - 12) Mod 3 = 0) Then
Set MyCell = Sws.Cells(Sr, Sc)
If (Lr = 1) Then
Sws.Cells(Sr, Sc) = "='" & Lws.Cells(1, Lc) & MyCell.Address
Else
Sws.Cells(1, 1) = "='" & Lws.Cells(Lr, Lc) & MyCell.Address
Sws.Cells(Sr, Sc) = Sws.Cells(Sr, Sc) + Sws.Cells(1, 1)
End If
End If
Next Sc
Next Sr

'Main Block 1 Data


For Sr = 14 To 28
For Sc = 14 To 29
If ((Sr - 12) Mod 3 = 0) Then
If (Sc = 14) Then
Sc = Sc + 1
End If
End If
Set MyCell = Sws.Cells(Sr, Sc)
If (Lr = 1) Then
Sws.Cells(Sr, Sc) = "='" & Lws.Cells(1, Lc) & MyCell.Address
Else
Sws.Cells(1, 1) = "='" & Lws.Cells(Lr, Lc) & MyCell.Address
Sws.Cells(Sr, Sc) = Sws.Cells(Sr, Sc) + Sws.Cells(1, 1)
End If
Next Sc
Next Sr

'Main Block 2 Data

For Sr = 34 To 36
For Sc = 14 To 22
If ((Sr - 12) Mod 3 = 0) Then
If (Sc = 14) Then
Sc = Sc + 1
End If
End If
Set MyCell = Sws.Cells(Sr, Sc)
If (Lr = 1) Then
Sws.Cells(Sr, Sc) = "='" & Lws.Cells(1, Lc) & MyCell.Address
Else
Sws.Cells(1, 1) = "='" & Lws.Cells(Lr, Lc) & MyCell.Address
Sws.Cells(Sr, Sc) = Sws.Cells(Sr, Sc) + Sws.Cells(1, 1)
End If
Next Sc
Next Sr


'Main Block 3 Data

For Sr = 38 To 40
For Sc = 14 To 18
If ((Sr - 12) Mod 3 = 0) Then
If (Sc = 14) Then
Sc = Sc + 1
End If
End If
Set MyCell = Sws.Cells(Sr, Sc)
If (Lr = 1) Then
Sws.Cells(Sr, Sc) = "='" & Lws.Cells(1, Lc) & MyCell.Address
Else
Sws.Cells(1, 1) = "='" & Lws.Cells(Lr, Lc) & MyCell.Address
Sws.Cells(Sr, Sc) = Sws.Cells(Sr, Sc) + Sws.Cells(1, 1)
End If
Next Sc
Next Sr


'Bottom Right Side Block Data

For Sr = 37 To 39
For Sc = 21 To 21
If ((Sr - 12) Mod 3 = 0) Then
If (Sc = 14) Then
Sc = Sc + 1
End If
End If
Set MyCell = Sws.Cells(Sr, Sc)
If (Lr = 1) Then
Sws.Cells(Sr, Sc) = "='" & Lws.Cells(1, Lc) & MyCell.Address
Else
Sws.Cells(1, 1) = "='" & Lws.Cells(Lr, Lc) & MyCell.Address
Sws.Cells(Sr, Sc) = Sws.Cells(Sr, Sc) + Sws.Cells(1, 1)
End If
Next Sc
Next Sr
Next Lr

Sws.Cells(2, 17) = Now()

Exit Sub
ErrorHandling:
Worksheets("Errors").Cells(Err, 1) = Now()
Worksheets("Errors").Cells(Err, 2) = Lws.Cells(Lr, Lc - 2)
Worksheets("Errors").Cells(Err, 3) = Lws.Cells(Lr, Lc - 1)
Worksheets("Errors").Cells(Err, 4) = MyCell.Address
Worksheets("Errors").Cells(Err, 5) = Worksheets("Testing").Cells(1, 1)
Worksheets("Testing").Cells(1, 1) = 0
Err = Err + 1
Resume Next
End Sub



I do realise there is a fair bit of repeated code there and it can be streamlined at least visually, but I am kind of a VBA hack at the moment, so be kind...

Any advice on reducing the run time of the macro would be appreciated.

Thanks in advance

Tim.

GTO
11-12-2008, 09:25 PM
Ayeeeeeeeeeee! My eyes!

Okay, I am totally and 100% teasing:) .


Greetings Tim,

I see this is your first post, so let me be the first to say "Welcome!". You will indeed meet some fine and very helpful folks here.

As to your question (hope you are chuckling, as I couldn't resist given your 'please be kind'), there are several ways to retrieve data from a closed workbook (wb).

For those of us who are a bit 'simple-minded' (ie - ME!) it is a bit hard to follow what cells are being looked at and the layout and all. Would it be possible to provide a cleaned-up copy of one source wb and of course, the wb that you are retrieving the data to? Please remove any private/company/proprietary info, as fake data works just as fine.

(You can zip the two examples to attach it to one post. There is a one attachment per post limit).

Now depending on what you have, your code (or more accurately, needs) may be beyond me, but I think this would get you a bette answer.

Hope to help,

Mark