Help with code efficiency - plotting data on a worksheet

[innov]

Hi Tek-Tippers.

I could really use your help here. I have tried several different things trying to speed up the code below, but it still takes an unusually long time.

I've got Application.Events & .Screenupdating set to false.
I also have Application.Calculation set to manual.

Below is the loop which runs through a 2 dimensional table defined by 2 named ranges, "Products" and "Entities". All I'm doing is plotting the 2 dimensional data into a single dimension worksheet. I 1st had the commented code below, but found (to my amazement!) that the copy / paste was faster! (but still slow overall).

ANY HELP WOULD BE GREATLY APPRECIATED!

innov
-------------------------------------------------------
Sub Rules_Export()
Application.EnableCancelKey = xlDisabled
error_source = "Export Rules"
If trap_errors Then: On Error GoTo Err_Handler

If Not Valid_Output_Folder Then: Exit Sub

ScrUpd (False)
Events (False)
AutoCalc (False)
Dim exppath, expfile, exptype, fileext, DriveSep As String

exppath = IIf(Right(FilePath, 1) = "\", FilePath, FilePath + "\")
' expfile = [RulesExport_File] 'need to capture since we're leaving this wkbk below
' exptype = [RulesExport_Type]
exptype = "XLS"

exp_row = 1 'set to 1. loop will skip first (header) row
prod_cnt = 0
ent_cnt = 0
'---- column numbers ----
date_col = 1
time_col = 2
prod_num_col = 3
prod_code_col = 4
prod_desc_col = 5
prod_src_col = 6
prod_lnamt_col = 7
prod_cap_col = 8
prod_adj1_col = 9
prod_adj2_col = 10

ent_name_col = 11
ent_mrg_col = 12
ent_lnamt_col = 13
ent_cap_col = 14

expdate = Format(Date$, "yyyy/mm/dd")
expfdate = Format(Date$, "yyyymmdd")
exptime = Format(Time$, "hh:mm:ss")

RulesExport.Unprotect (wksh_pswd)
RulesExport.Range("A2:Z12000").ClearContents

frm_Export.Show
frm_Export.Repaint

'-- Traverse the Rules table: (a) by Product; (b) by Entity

For Each prod In [Products]
If Len(Trim(prod.Value)) > 0 Then
prod_cnt = prod_cnt + 1
For Each ent In [Entity_Area]
If Not Len(Trim(ent.Value)) > 0 Then
Exit For
End If

ent_col = _
WorksheetFunction.Match(ent, [Entities], 0) + _
Entities].Column - 1
exp_row = exp_row + 1

RulesExport.Cells(exp_row, date_col) = expdate
RulesExport.Cells(exp_row, time_col) = exptime
'--- product level info ---------
'RulesExport.Cells(exp_row, prod_num_col) = Rules.Cells(prod.Row, prod.Column - 1)
'RulesExport.Cells(exp_row, prod_code_col) = Rules.Cells(prod.Row, prod.Column)
'RulesExport.Cells(exp_row, prod_desc_col) = Rules.Cells(prod.Row, prod.Column + 1)
'RulesExport.Cells(exp_row, prod_adj1_col) = Rules.Cells(prod.Row, prod.Column + 5)
'RulesExport.Cells(exp_row, prod_adj2_col) = Rules.Cells(prod.Row, prod.Column + 6)
'RulesExport.Cells(exp_row, prod_lnamt_col) = Rules.Cells(prod.Row, prod.Column + 3)
'RulesExport.Cells(exp_row, prod_cap_col) = Rules.Cells(prod.Row, prod.Column + 4)
'--- entity level info ----------
'RulesExport.Cells(exp_row, ent_name_col) = ent.Value
'RulesExport.Cells(exp_row, ent_mrg_col) = Rules.Cells(prod.Row, ent_col)
'RulesExport.Cells(exp_row, ent_lnamt_col) = Rules.Cells(prod.Row, ent_col + 1)
'RulesExport.Cells(exp_row, ent_cap_col) = Rules.Cells(prod.Row, ent_col + 2)

'--- product level info ---------
Rules.Range(Cells(prod.Row, prod.Column - 1), Cells(prod.Row, prod.Column + 6)).Copy
RulesExport.Cells(exp_row, prod_num_col).PasteSpecial (xlValues)
'--- entity level info ----------
ent.Copy
RulesExport.Cells(exp_row, ent_name_col).PasteSpecial (xlValues)
Rules.Range(Cells(prod.Row, ent_col), Cells(prod.Row, ent_col + 1)).Copy
RulesExport.Cells(exp_row, ent_mrg_col).PasteSpecial (xlValues)

Application.CutCopyMode = False

Next ent

End If
Next prod

*- code to save temp workbork "as xyz" ---

Events (True)
AutoCalc (True)
ScrUpd (True)

End Sub

 

[Nikita6003]

Hi innov,

Looking at your code I think your main problem is the use of the WorkSheetFunction.

You've gort a few alternatives to the Match approach: since you use MatchType = 0, you could simply use FIND instead of match to get you the same result
Change

ent_col = WorksheetFunction.Match(ent, [Entities], 0) + [Entities].Column - 1

into

ent_col = Application.Range("Entities").Find(ent).Column

Worksheetfunctions can be VERY slow in Excel when compared to native VBA which'll do something similar.
See also the following link for more tips on speeding up code.

HTH

Cheers
Nikki
Look, mommy, I'm flying!

 

[Nikita6003]

and here *IS* the following link ...

http://www.avdf.com/apr98/art_ot003.html

(sorry - long hard day yesterday ;-))


Cheers
Nikki
Look, mommy, I'm flying!

 

[innov]

Thanks for the feedback, Nikita!

I'll definitely remove the worksheetfunction.

FYI, I also did some timebenchmarks (with msgboxes) and found that the following code was also a culprit.

RulesExport.Cells(exp_row, date_col) = expdate
RulesExport.Cells(exp_row, time_col) = exptime

It was the remaining "VBA to worksheet" movement.
Since I was going to use the expdate & exptime value repeatly, I move the value to 2 cells one time and then use the copy pastevalues again. And it made a HUGE difference. I'll be going back and inspecting other processes for similar opportunities.

Thanks again!

innov