how to optimise sumproduct function

[WINFS]

Hi:

I have a workbook to consolidate expenses incurred for the month. Each type of the expenses is given a code so that I could use the Sumproduct function to sum up the total of that particular category of expenses for the month (example enclosed). However, the Sumproduct function becomes very slow to recalc when there are large number of worksheets involved. Is there any other way to achieve the same results faster?

The expenses listing worksheets are actually prepared in separate workbooks and are then copy and paste into the said consolidated workbook. Is there a way to automate this manual process for the example enclosed?

Thanks for your help in advance.

[f2e4]

I may have misunderstood your question...

but i can not find where you have used the SUMPRODUCT function

[figment]

i see no way to optimize these sumproducts, as for the automating the cut and pasting, yes that can be done, but we will need more information. such as the name of the other workbooks. are they all stored in the same place? is it the same place as this file? and how many are there.

[WINFS]

The information is copy and paste from corresponding month worksheets stored in 2 files e.g aab.xls and bbc.xls (enclosed). all these files are stored in the same directory. For example, in Jun, the "Jun" worksheets in aab.xls and bbc.xls are copy and paste in "aab" and "bbc" worksheet in the consolidated workbook. For Jul, the same process repeats. Any help would be appreciated.

[WINFS]

could someone pls help to improve the codes?
thanks.

Sub Macro1()
'
Call cp("c:\temp\aab.xls", "aab", "Jan")
Call cp("c:\temp\bbc.xls", "bbc", "Jan")

End Sub

Sub cp(ByVal InputFile As String, ByVal OutputSheet As String, ByVal InputSheet As String)

Dim wb As Workbook
Application.ScreenUpdating = False
Set wb = Workbooks.Open(InputFile, True, True)
Sheets(InputSheet).Range("A1:AZ300").Copy
wb.Close False
Set wb = Nothing


Sheets(OutputSheet).Activate
Sheets(OutputSheet).Range("A1:AZ300").Select
Sheets(OutputSheet).Paste
Application.ScreenUpdating = True

End Sub

[Bob Phillips]

Improve in what way, what do you see as wrong with them?

[WINFS]

I'm a newbie. I may be wrong. These codes are "assembled" from various sources. It seems to be a bit too lengthy for the copy and paste purpose between workbooks. It also does not warn if the other workbooks are already opened.

regards,

[Bob Phillips]

Okay, try this then



Sub Macro1()
'
Call cp("c:\temp\aab.xls", "aab", "Jan")
Call cp("c:\temp\bbc.xls", "bbc", "Jan")

End Sub

Sub cp(ByVal InputFile As String, ByVal OutputSheet As String, ByVal InputSheet As String)
Dim This As Workbook
Dim wb As Workbook
Dim aryPath As Variant

Application.ScreenUpdating = False

On Error Resume Next
aryPath = Split(InputFile, "\")
Set wb = Workbooks(aryPath(UBound(aryPath)))
On Error GoTo 0
If wb Is Nothing Then

Set wb = Workbooks.Open(InputFile, True, True)
wb.Sheets(InputSheet).Range("A1:AZ300").Copy
wb.Close False
Else

wb.Sheets(InputSheet).Range("A1:AZ300").Copy
End If
Set wb = Nothing

This.Sheets(OutputSheet).Range ("A1")

Application.ScreenUpdating = True

End Sub

[WINFS]

Thanks for your swift reply.

However, the macro has a runtime error 9 at
This.Sheets(OutputSheet).Range ("A1")

[Bob Phillips]

I missed a bit, but it still doesn't work as the aab.xls doesn't have an aab worksheet.



Sub Macro1()
'
Call cp("c:\temp\aab.xls", "aab", "Jan")
Call cp("c:\temp\bbc.xls", "bbc", "Jan")

End Sub

Sub cp(ByVal InputFile As String, ByVal OutputSheet As String, ByVal InputSheet As String)
Dim This As Workbook
Dim wb As Workbook
Dim aryPath As Variant

Application.ScreenUpdating = False

Set This = ActiveWorkbook
On Error Resume Next
aryPath = Split(InputFile, "\")
Set wb = Workbooks(aryPath(UBound(aryPath)))
On Error GoTo 0
If wb Is Nothing Then

Set wb = Workbooks.Open(InputFile, True, True)
wb.Sheets(InputSheet).Range("A1:AZ300").Copy
wb.Close False
Else

wb.Sheets(InputSheet).Range("A1:AZ300").Copy
End If
Set wb = Nothing

This.Sheets(OutputSheet).Range ("A1")

Application.ScreenUpdating = True

End Sub

[WINFS]

It should copy from the input sheet "Jan" from aab.xls to output sheet "aab" in the template and from "Jan" sheet in bbc.xls to "bbc" sheet in the template.

by the way, what is the function of these codes?

On Error Resume Next
aryPath = Split(InputFile, "\")
Set wb = Workbooks(aryPath(UBound(aryPath)))
On Error Goto 0

[Aussiebear]

As I read your request WINFS, you require your code to copy the individual monthly worksheets from the workbooks aab.xls & bbc.xls to their respective sheets in the Consolidated workbook, right?

XLD has rightly pointed out that you don't have any sheets in either of the aab.xls & bbc.xls workbooks named as "aab"

What happens if you change the code to this


Sub Macro1()
'
Call cp("c:\temp\aab.xls", "Jan")
Call cp("c:\temp\bbc.xls", "Jan")

End Sub

[WINFS]

I may be not clear on one point.

It need not to copy all the worksheets in aab.xls and bbc.xls to the consolidated workbook.

It should only copy from the input sheet "Jan" (or any other month specified) from aab.xls to output sheet "aab" in the consolidated workbook and from "Jan" sheet in bbc.xls to "bbc" sheet in the consolidated workbook. The consolidated workbook already has "aab" and "bbc" worksheet.

regrads,

[Bob Phillips]

Maybe thi is what you need, guessing I am afraid



Sub Macro1()
'
Call cp("c:\temp\aab.xls", "aab", "Jan")
Call cp("c:\temp\bbc.xls", "bbc", "Jan")

End Sub

Sub cp(ByVal InputFile As String, ByVal InputSheet As String, ByVal OutputSheet As String)
Dim This As Workbook
Dim wb As Workbook
Dim aryPath As Variant

Application.ScreenUpdating = False

Set This = ActiveWorkbook
On Error Resume Next
aryPath = Split(InputFile, "\")
Set wb = Workbooks(aryPath(UBound(aryPath)))
On Error Goto 0
If wb Is Nothing Then

Set wb = Workbooks.Open(InputFile, True, True)
wb.Sheets(InputSheet).Range("A1:AZ300").Copy
wb.Close False
Else

wb.Sheets(InputSheet).Range("A1:AZ300").Copy
End If
Set wb = Nothing

This.Sheets(OutputSheet).Range ("A1") .Paste

Application.ScreenUpdating = True

End Sub