PDA

View Full Version : Macro speed



Gordon Scott
12-08-2006, 05:38 AM
Can anyone tell me how i can speed up my macro, I have a large spreadsheet and it takes about a minute to run

Many Thanks

Gordon

malik641
12-08-2006, 06:16 AM
Hey Gordon, welcome to VBAX :hi:

Check out this article by Johnske:

http://vbaexpress.com/forum/showthread.php?t=9882

But if you want us to help with your code specifically, please post your own code that you need help with :)

mdmackillop
12-08-2006, 06:18 AM
Hi Gordon,
Two options
1. Hit the shortcut key harder
2. Post the code so we can have a look at it
Regards
MD

Gordon Scott
12-08-2006, 08:10 AM
It is too large to attach even if i zip it but i could email it to someone if they could help.

Gordon

Bob Phillips
12-08-2006, 08:14 AM
time the separate macros and see where the bottlenecks are, then post those if you need help.

Norie
12-08-2006, 02:12 PM
Gordon

Can you post a little bit of your code?

There's no real need for an attachment, at this stage anyway.:)

mdmackillop
12-08-2006, 03:25 PM
Here's Gordon's code

Public istart_line, iblank_max, start_column$, end_column$, trans_column$
Public test_bl_column1$, test_bl_column2$, sum_start_column$, sum_end_column$
Public istart_column, iend_column, itrans_column, itest_bl_column1, itest_bl_column2
Public isum_start_column, isum_end_column, icurrent_transfer_flag, transfer_to$
Public gt1_start$, gt1_end$, igt1_start, igt1_end, igt1_inc
Public gt2_start$, gt2_end$, igt2_start, igt2_end, igt2_inc
Public iwo_col, iMast_trak_start, iMast_trak_end, iTrak_retain_start, iTrak_retain_end, trak_sheet$
Public Mast_trak_start$, Mast_trak_end$, Trak_retain_start$, Trak_retain_end$

Sub process()
istart_line = Worksheets("Definitions").Cells(2, 2).Value2
iblank_max = Worksheets("Definitions").Cells(3, 2).Value2
start_column$ = Worksheets("Definitions").Cells(4, 2).Value2
end_column$ = Worksheets("Definitions").Cells(5, 2).Value2
trans_column$ = Worksheets("Definitions").Cells(6, 2).Value2
test_bl_column1$ = Worksheets("Definitions").Cells(7, 2).Value2
test_bl_column2$ = Worksheets("Definitions").Cells(8, 2).Value2
sum_start_column$ = Worksheets("Definitions").Cells(9, 2).Value2
sum_end_column$ = Worksheets("Definitions").Cells(10, 2).Value2
gt1_start$ = Worksheets("Definitions").Cells(11, 2).Value2
gt1_end$ = Worksheets("Definitions").Cells(12, 2).Value2
igt1_inc = Worksheets("Definitions").Cells(13, 2).Value
gt2_start$ = Worksheets("Definitions").Cells(14, 2).Value2
gt2_end$ = Worksheets("Definitions").Cells(15, 2).Value2
igt2_inc = Worksheets("Definitions").Cells(16, 2).Value
WO_col$ = Worksheets("Definitions").Cells(17, 2).Value2
Mast_trak_start$ = Worksheets("Definitions").Cells(18, 2).Value2
Mast_trak_end$ = Worksheets("Definitions").Cells(19, 2).Value2
Trak_retain_start$ = Worksheets("Definitions").Cells(20, 2).Value2
Trak_retain_end$ = Worksheets("Definitions").Cells(21, 2).Value2
'Debug.Print Trak_retain_end$
Call get_ref1(start_column$, istart_column)
Call get_ref1(end_column$, iend_column)
Call get_ref1(trans_column$, itrans_column)
Call get_ref1(test_bl_column1$, itest_bl_column1)
Call get_ref1(test_bl_column2$, itest_bl_column2)
Call get_ref1(sum_start_column$, isum_start_column)
Call get_ref1(sum_end_column$, isum_end_column)
Call get_ref1(gt1_start$, igt1_start)
Call get_ref1(gt1_end$, igt1_end)
Call get_ref1(gt2_start$, igt2_start)
Call get_ref1(gt2_end$, igt2_end)
Call get_ref1(WO_col$, iwo_col)
Call get_ref1(Mast_trak_start$, iMast_trak_start)
Call get_ref1(Mast_trak_end$, iMast_trak_end)
Call get_ref1(Trak_retain_start$, iTrak_retain_start)
Call get_ref1(Trak_retain_end$, iTrak_retain_end)
' the user entered data in the tracker will be transferred back to the master
' temporarily
'Debug.Print istart_column, iend_column, itrans_column
For itrans = 2 To 21
icurrent_transfer_flag = Worksheets("Definitions").Cells(itrans, 3).Value
If icurrent_transfer_flag > 0 Then
transfer_to$ = Worksheets("Definitions").Cells(itrans, 4).Value
trak_sheet$ = Worksheets("Definitions").Cells(itrans, 5).Value
If trak_sheet$ <> "" Then
Call recall_tracker
End If
Call sheet_transfer(1)
If trak_sheet$ <> "" Then
Call sheet_transfer(2)
Call transfer_tracker
End If
End If
Next itrans
Sheets("Master").Select
Range("A" & istart_line).Select
Range("A1").Select
End Sub

Sub recall_tracker()
For i = istart_line To 65535
test$ = Worksheets(trak_sheet$).Cells(i, iwo_col).Value2
If test$ <> "" Then
' found entry in trakker sheet, find matching entry in master sheet
For j = istart_line To 65535
itransfer_flag = Val(Worksheets("Master").Cells(j, itrans_column).Value2)
' -3 denotes last line of master and will not have a job number, so exit
If itransfer_flag = -3 Then
Exit For
Else
test_match$ = Worksheets("Master").Cells(j, iwo_col).Value2
If test_match$ = test$ Then
' match found so copy back the user entered data into the master worksheet
iout = itrans_column
For k = iTrak_retain_start To iTrak_retain_end
iout = iout + 1
Worksheets("Master").Cells(j, iout).Value2 = Worksheets(trak_sheet$).Cells(i, k).Value2
Next k
End If
End If
Next j
End If
Next i
Application.ScreenUpdating = False
End Sub

Sub transfer_tracker()
For i = istart_line To 65535
test$ = Worksheets(trak_sheet$).Cells(i, iwo_col).Value2
If test$ <> "" Then
' found entry in trakker sheet, find matching entry in master sheet
For j = istart_line To 65535
itransfer_flag = Val(Worksheets("Master").Cells(j, itrans_column).Value2)
' -3 denotes last line of master and will not have a job number, so exit
If itransfer_flag = -3 Then
Exit For
Else
test_match$ = Worksheets("Master").Cells(j, iwo_col).Value2
If test_match$ = test$ Then
' match found so copy back the user entered data into the master worksheet
iout = itrans_column
For k = iTrak_retain_start To iTrak_retain_end
iout = iout + 1
Worksheets(trak_sheet$).Cells(i, k).Value2 = Worksheets("Master").Cells(j, iout).Value2
Worksheets("Master").Cells(j, iout).Value2 = ""
Next k
End If
End If
Next j
End If
Next i
End Sub

Sub sheet_transfer(mode)
iout = istart_line - 1
icount_blank = 0
istart_sum_row = 0
iend_sum_row = 0
If mode = 1 Then
use_sheet$ = transfer_to$
start_column_use$ = start_column$
end_column_use$ = end_column$
isum_start_column_use = isum_start_column
isum_end_column_use = isum_end_column
Else
use_sheet$ = trak_sheet$
start_column_use$ = Mast_trak_start$
end_column_use$ = Mast_trak_end$
isum_start_column_use = iMast_trak_start
isum_end_column_use = iMast_trak_end
End If
Sheets(use_sheet$).Select
Rows(istart_line & ":65536").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
For i = istart_line To 65536
'test for a blank input line. If there have been more thasn iblank_max blank lines,
'then exit from the for-nextI loop to avoid looping until I=65536
test$ = Worksheets("Master").Cells(i, itest_bl_column1).Value2 & _
Worksheets("Master").Cells(i, itest_bl_column2).Value2
If test$ = "" Then
icount_blank = icount_blank + 1
If icount_blank > iblank_max Then
' Debug.Print i
Exit For
End If
Else
'non blank found so reset blank count
icount_blank = 0
End If
itransfer_flag = Val(Worksheets("Master").Cells(i, itrans_column).Value2)
If itransfer_flag = icurrent_transfer_flag Or itransfer_flag = -1 Then
' transfer a section header row or filled data line to the output list
Sheets("Master").Select
copy_range$ = start_column_use$ & i & ":" & end_column_use$ & i
Range(copy_range$).Select
Selection.Copy
Sheets(use_sheet$).Select
iout = iout + 1
Range(start_column_use$ & iout).Select
ActiveSheet.Paste
If itransfer_flag > 0 Then
' a data line has been transferred so set the end sum row
iend_sum_row = iout
lines_transferred = lines_transferred + 1
End If
End If
If itransfer_flag = -1 Then
' header has been transferred so set start row for the summations
istart_sum_row = iout + 1
lines_transferred = 0
iend_sum_row = 0
End If
If itransfer_flag = -2 And lines_transferred > 0 Then
' create a summation line in the output, the end row for summation is
' the previous output line
iout = iout + 1
If mode = 1 Then
Sheets("Master").Select
copy_range$ = start_column_use$ & i & ":" & end_column_use$ & i
Range(copy_range$).Select
Selection.Copy
Sheets(use_sheet$).Select
Range(start_column_use$ & iout).Select
ActiveSheet.Paste
' Debug.Print "istart_sum_row", istart_sum_row, "iend_sum_row", iend_sum_row
For j = isum_start_column_use To isum_end_column_use
Call get_col(j, col$)
sum_range$ = col$ & istart_sum_row & ":" & col$ & iend_sum_row
Worksheets(use_sheet$).Cells(iout, j).Formula = "=sum(" & sum_range$ & ")"
' Debug.Print j, sum_range$
Next j
Else
Sheets(use_sheet$).Select
Range(Mast_trak_start$ & iout & ":" & Trak_retain_end$ & iout).Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
End If
lines_transferred = 0
End If
If itransfer_flag = -3 And mode = 1 Then
' create a final summation line pair
isum_end = iout
Sheets("Master").Select
iout = iout + 1
copy_range$ = i & ":" & i + 1
Rows(copy_range$).Select
Selection.Copy
Sheets(use_sheet$).Select
Rows(iout & ":" & iout + 1).Select
ActiveSheet.Paste
' Debug.Print "istart_sum_row", istart_sum_row, "iend_sum_row", iend_sum_row
For j = igt1_start To igt1_end Step igt1_inc
Call get_col(j, col$)
if_range$ = trans_column$ & istart_line & ":" & trans_column$ & isum_end
if_test$ = """=-2"""
sum_range$ = col$ & istart_line & ":" & col$ & isum_end
sum_formula$ = "=SUMIF(" & if_range$ & "," & if_test$ & "," & sum_range$ & ")"
Worksheets(use_sheet$).Cells(iout, j).Formula = sum_formula$
' Debug.Print iout, j, col$, sum_formula$
Next j
For j = igt2_start To igt2_end Step igt2_inc
Call get_col(j, col$)
if_range$ = trans_column$ & istart_line & ":" & trans_column$ & isum_end
if_test$ = """=-2"""
sum_range$ = col$ & istart_line & ":" & col$ & isum_end
sum_formula$ = "=SUMIF(" & if_range$ & "," & if_test$ & "," & sum_range$ & ")"
Worksheets(use_sheet$).Cells(iout, j).Formula = sum_formula$
' Debug.Print iout, j, col$, sum_formula$
Next j
iout = iout + 1
' lines_transferred = 0
End If
Next i
End Sub

Sub get_ref1(col$, icol)
If Len(col$) = 1 Then
icol = Asc(col$) - Asc("A") + 1
ElseIf Len(col$) = 2 Then
'Debug.Print col$
icol = (Asc(Left(col$, 1)) - Asc("A") + 1) * 26 + Asc(Right(col$, 1)) - Asc("A") + 1
'Debug.Print col$, Asc(Left(col$, 1)) - Asc("A"), Asc(Right(col$, 1)) - Asc("A"), icol
End If
End Sub

Sub get_col(icol, col$)
If icol <= 26 Then
' single character column
col$ = Chr(icol + 64)
Else
' double character column
icol1 = Int((icol - 1) / 26)
icol2 = ((icol - 1) Mod 26) + 1
' Debug.Print icol, icol1, icol2
col$ = Chr(icol1 + 64) & Chr(icol2 + 64)
End If
End Sub

Sub test_sub()
Call get_col(1, col$)
Debug.Print col$
Call get_col(25, col$)
Debug.Print col$
Call get_col(26, col$)
Debug.Print col$
Call get_col(27, col$)
Debug.Print col$
Call get_col(50, col$)
Debug.Print col$
Call get_col(51, col$)
Debug.Print col$
Call get_col(52, col$)
Debug.Print col$
End Sub

mdmackillop
12-08-2006, 03:42 PM
Hi Gordon,
A quick inspection shows that you are cycling all rows to 65536 on a number of occassions. Replace this number with the number of the last row required to be processed. This could be done with

For i = istart_line To Worksheets(trak_sheet$).SpecialCells(xlCellTypeLastCell).Row

or

For i = istart_line To Worksheets(trak_sheet$).Cells(Rows.Count,1).End(xlup).Row

johnske
12-08-2006, 04:04 PM
A major cause would be all the Variant type variables used, declare all the types (Long, Range,..., etc).

Also, why is Value2 being used here?

Gordon Scott
12-11-2006, 01:35 AM
Hi Malcolm

Where will i have to insert that code and will i have to delete anything?

Gordon

Norie
12-11-2006, 02:56 AM
Gordon

Why all the looping? I think I counted at least 10 loops in the code.

Also, why all the selecting? It's generally unneeded to select anything to work with it.

Gordon Scott
12-11-2006, 03:06 AM
Hi Norie

I am quite new to working with macros and i was sent the original macro and amended it to suit. Im not too sure about looping, can you suggest what i can do.

Thanks

Gordon

Norie
12-11-2006, 03:13 AM
Gordon

What is the purpose of the code?

I've looked at it a couple of times now and I still can't quite fathom what
it's meant to do.

Mind you it is Monday morning.:)

PS there is also a lot of calls to the subs get_col and get_ref1 but I can't quite work out why.

Gordon Scott
12-11-2006, 03:33 AM
Norie

What it does is if i insert a 1 or 2 into column A in the master sheet and run the macro it sends the relevent line to the appropriate sheet. The spreadsheet is too big to attach but i could email it to you if you want to have a look.

Regards

Gordon

Bob Phillips
12-11-2006, 04:04 AM
That's a hell of a lot of code for such a small task.

Re 65536 lines, your nested loops cycling through all rows are definitely a BIG problem, but I don't think anyone will be able to break it down for you, it is far too complicated for a support gig.

Why do you cycle through all rows, and within those loops, cycle through them all again. It would seem better to me to use Find to search for matches (but that is a conclusion from a far from detailed look at the code).

Gordon Scott
12-11-2006, 06:17 AM
Hi

Is there anyway i can just change the number of rows, I only need 2000 max, or can someone tell me how to remove all the loops.

:help
Gordon

mdmackillop
12-11-2006, 06:39 AM
Hi Gordon
See Post #8

Gordon Scott
12-11-2006, 07:04 AM
Malcolm thanks but where do i insert it and what do i delete

Gordon

Bob Phillips
12-11-2006, 07:06 AM
Hi Gordon
See Post #8

That will help MD, but I think he needs to re-think/re-design what's going on. As I said, whole columns lopps on one sheet within a whole column loop on another cannot be right. And why so much code for a simple requirement?

Norie
12-11-2006, 10:53 AM
Gordon

This could probably be handled using a worksheet change event.

When you say the row is 'sent' to the 'appropriate' sheet what exactly do you mean?

SamT
12-11-2006, 02:33 PM
Here's one problem;


For i = istart_line To 65536
'test for a blank input line. If there have been more than iblank_max blank lines,
'then exit from the for-next loop to avoid looping until I=65536
test$ = Worksheets("Master").Cells(i, itest_bl_column1).Value2 & _
Worksheets("Master").Cells(i, itest_bl_column2).Value2

'itest_bl_column{1 & 2} have not been set to anything!!!

If test$ = "" Then
icount_blank = icount_blank + 1
If icount_blank > iblank_max Then
Exit For
End If
Else
'non blank found so reset blank count
icount_blank = 0

'iblank_max = Definitions!$B$3.Value2. If it's anything
'other than 1, icount_blank will never reach it
'so the above test is probably worthless.

End If




Also not set before first use:
isum_start_column
isum_end_column
itrans_column
itest_bl_column1
For j = igt1_start To igt1_end Step igt1_inc

Only used in one sub, should not be Public:
trans_column$

Not used anywhere are:
itest_bl_column2
test_bl_column2$,
gt1_start$
gt1_end$
test_bl_column1$
istart_column,
iend_column,
sum_end_column$
sum_start_column$

Plus more I don't have time to research.

IMHO, this is a wonderful example of how NOT to name variables.
Mostly uncapitalised, starting with improper Type signs, ie: iend_column is a varient type. Some words Capped some times, ie; Mast_trak_start, Trak_retain_start. Names with 1 letter difference, ie; istart_column, start_column$. Overuse of some words, ie; over 2/3 of the variables have start or end in them.

PS, some vars may only have been used in the test debug prcedures. Deleted 'em and don't have 'em in front of me right now.

Gordon Scott
12-12-2006, 12:55 AM
Norie

What it does is there is a master sheet with a process button on it and when you insert info into it then put a 1 into column A and hit process it copies the info on that row to a worksheet called working and one called tracker, insert a 2 and it goes to one called complete. The problem is the more info the longer it takes to process, over a minute on some of them. Hope this makes more sence now.

Gordon

Bob Phillips
12-12-2006, 03:33 AM
From your description, all you need is



With Worksheets("Master")
If .Cells(ActiveCell.Row, "A") = 1 Then
.ActiveCell.EntireRow.Copy Worksheets("Tracker").Cells(ActiveCell.Row, "A")
ElseIf .Cells(ActiveCell.Row, "A") = 2 Then
.ActiveCell.EntireRow.Copy Worksheets("Complete").Cells(ActiveCell.Row, "A")
End If
End With


What does this miss that your code handles?

JimmyTheHand
12-14-2006, 08:21 AM
:hi: Gordon,

You must have a 200 HorsePower PC :thumb if the macro takes you 1 minute to complete. For me, with an AMD FX64, 1024 MB RAM, it took almost 10 minutes.

But I think I found something. Take a look at this part of the code:
Sub recall_tracker()
'there is some more (irrelevant) code here
For j = istart_line To 65535
itransfer_flag = Val(Worksheets("Master").Cells(j, itrans_column).Value2)
' -3 denotes last line of master and will not have a job number, so exit
If itransfer_flag = -3 Then
Exit For
Else It looks at column "FN" of current row, and exits the loop if -3 is found.
The problem is that in the workbook you emailed me there's no -3 in column "FN" on the "Master" sheet. So it goes through all 65536 rows.
Row 826 looked to be the last row on "Master", so I put a -3 into cell FN827.
The macro got a thousand times faster without altering the code in any way.

Try it, and give me feedback.

Zack Barresse
12-14-2006, 03:07 PM
I agree with Bob, a restructuring could be very advantageous here. I'm still not quite sure what the entire scope of this application is. If you cannot upload the spreadsheet, how about a scaled down sample? You can attached zipped files also.

mdmackillop
12-14-2006, 04:40 PM
One of the problems is your nested loops. The inner most as coded here

For k = iTrak_retain_start To iTrak_retain_end
iout = iout + 1
Worksheets(trak_sheet$).Cells(i, k).Value2 = Worksheets("Master").Cells(j, iout).Value2
Worksheets("Master").Cells(j, iout).Value2 = ""
Next k

is handling one cell at a time. As you can determine the number of times the loop will run, you can define the ranges to accomplish this in one action. Something like

Rws = iTrak_retain_end - iTrak_retain_start

Worksheets("Master").Range(Cells(j, iout), Cells(j, iout + Rws)).Value2 = _
Worksheets(trak_sheet$).Range(Cells(i, k), Cells(i, k + Rws)).Value2
iout = iout + Rws

Gordon Scott
12-15-2006, 02:30 AM
Malcolm

Where should i insert that code and should i delete anything?

Gordon

JimmyTheHand
12-15-2006, 05:22 AM
:hi: Gordon,

I rewrote the recall_tracker sub. My version is below. It's faster than the original but, unfortunately, I have no way to check if it does the same. It should, as far as I know, but can't be sure. Please replace the original with this one, and run it with your data.


Sub recall_tracker()
Dim Hit As Long
Dim RngToCopy As Range, CopyTgt As Range
Application.ScreenUpdating = False
For i = istart_line To 65535
test$ = Worksheets(trak_sheet$).Cells(i, iwo_col).Value2
If test$ <> "" Then
' found entry in trakker sheet, find matching entry in master sheet
On Error GoTo NoHits
Hit = Worksheets("Master").Columns(iwo_col).Find(What:=test$, LookIn:=xlValues).Row
Set RngToCopy = Sheets(trak_sheet$).Range(Sheets(trak_sheet$).Cells(i, iTrak_retain_start), Sheets(trak_sheet$).Cells(i, iTrak_retain_end))
Set CopyTgt = Sheets("Master").Range(Sheets("Master").Cells(Hit, itrans_column + 1), Sheets("Master").Cells(Hit, itrans_column + iTrak_retain_end - iTrak_retain_start + 1))

RngToCopy.Copy
CopyTgt.PasteSpecial Paste:=xlPasteValues
NoHits:
End If
Next i
Application.ScreenUpdating = True
End Sub