• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro takes around 40 minutes to run

ThrottleWorks

ThrottleWorks

Excel Ninja
Hi I have a macro, this macro is not desgined me.

The macro takes around 40 minutes to run.


This is desgined by experts and I am not able to understand the code.

Can someone help me to reduce the running time of the macro please.


The macro does various calculations.


1 main condition used in the loop is cell has to be non-blank.

Do while loops are used in the macro.

At present I have 900 non-blank rows.


I have pasted the code used below.


Code with my comments

----------------------------------------------------------------------------------------

Sub Report_Sachin()

Application.ScreenUpdating = False

Windows("New.xlsm").Activate
Sheets("abc").Select
'Range D1
td = Cells(1, 4)

Windows("data.xlsx").Activate
Sheets("Data").Select
'Cells(1,7) is range G1
'if date in G1 <> range D1 - 1 in accrual sheet then
'Date in the cell G1 wll be replaced with Cell D1
If Cells(1, 7) <> td - 1 Then
MsgBox ("Pls Check the date")
End
Else: Cells(1, 7) = td
End If

Windows("New.xlsm").Activate
Sheets("abc").Select
'Cells(1,3) is range c1 from accrual sheet
'if this is = cells(1,4) i.e. range d1 then
If Cells(1, 3) = Cells(1, 4) Then
Windows("New.xlsm").Activate
Sheets("abc").Select
k = 4
'Cells(k,2) is range B4
'Do untill B4 is blank
Do Until Cells(k, 2) = ""

isin = Cells(k, 2)
acc = Cells(k, 4)

Windows("data.xlsx").Activate
Sheets("Data").Select
l = 3

'Cells(l,1) is range A3
'This line is checkign wheather currency is blank
'if cells(i,5) i.e. E3 is = isin value (isin here is a variable declared above)
'then update the value acc in column AV i.e. DI
'acc is calculated in the accrual sheet
Do Until Cells(l, 1) = ""
If Cells(l, 5) = isin Then
Cells(l, 48) = acc
Exit Do
End If

l = l + 1

Loop

k = k + 1

Windows("New.xlsm").Activate
Sheets("abc").Select

Loop

End If

Windows("data.xlsx").Activate
Sheets("Data").Select

'cell(j,1) in is Range A3
'Do untill cells in the column A are blank

j = 3
Do Until Cells(j, 1) = ""
'cells (j,21) is column U
'cells (j,23) is column W
'cells (j,22) is column V

Cells(j, 21) = Cells(j, 23)
Cells(j, 22) = Cells(j, 23)

'cells (j,52) is column AZ
'cells (j,52) is cells (j,52) + cells (j,48)
'cells (j,48) is column AV
'cells (j,56) is cells (j,56) + cells (j,48)
'cells (j,56) is column BD

Cells(j, 52) = Cells(j, 52) + Cells(j, 48)
Cells(j, 56) = Cells(j, 56) + Cells(j, 48)

'cells (j,49) is column AW
br />Cells(j, 49) = 0

j = j + 1
Windows("data.xlsx").Activate
Sheets("Data").Select
Loop

MsgBox "Done !"

Application.ScreenUpdating = True

End Sub

---------------------------------------------------------------------------------------


Clean code (without comments)

[pre]
Code: 
Sub Report_Sachin()

Application.ScreenUpdating = False

Windows("New.xlsm").Activate
Sheets("abc").Select

td = Cells(1, 4)

Windows("data.xlsx").Activate
Sheets("Data").Select
If Cells(1, 7) <> td - 1 Then
MsgBox ("Pls Check the date")
End
Else: Cells(1, 7) = td
End If

Windows("New.xlsm").Activate
Sheets("abc").Select
If Cells(1, 3) = Cells(1, 4) Then
Windows("New.xlsm").Activate
Sheets("abc").Select
k = 4

Do Until Cells(k, 2) = ""

isin = Cells(k, 2)
acc = Cells(k, 4)

Windows("data.xlsx").Activate
Sheets("Data").Select
l = 3

Do Until Cells(l, 1) = ""
If Cells(l, 5) = isin Then
Cells(l, 48) = acc
Exit Do
End If

l = l + 1

Loop

k = k + 1

Windows("New.xlsm").Activate
Sheets("abc").Select

Loop

End If

Windows("data.xlsx").Activate
Sheets("Data").Select

j = 3
Do Until Cells(j, 1) = ""

Cells(j, 21) = Cells(j, 23)
Cells(j, 22) = Cells(j, 23)

Cells(j, 52) = Cells(j, 52) + Cells(j, 48)
Cells(j, 56) = Cells(j, 56) + Cells(j, 48)

Cells(j, 49) = 0

j = j + 1
Windows("data.xlsx").Activate
Sheets("Data").Select
Loop

MsgBox "Done !"

Application.ScreenUpdating = True

End Sub
[/pre]
----------------------------------------------------------------------------------------
 
Can you please post the data.xlsx and new.xlsx workbooks?
Click to expand...

Actually, post a xlsm or xlsb type format please. If you do a Save As xlsx, it will strip out all your macros! =O
 
First pass, I'd make sure you define all your variable and set what you expect them to be. This will reduce the amount of time XL needs to figure out what type of variable it should use. Also, try not to select things if you can. Instead of:

[pre]
Code: 
Worksheets("ABC").select
td = Cells(1,2)[/pre]
try doing:

td = Worksheets("ABC").Cells(1,2).Value


On that note, try to indicate what propery of the Cells you want to use. For this code, it looks like you want to look at the Value. If you don't include that, the compiler has to figure out what you want (formula, format, address, value, text, etc...)
 
In addition with Luke..


Try to set

[pre]
Code: 
Set NewXlsm = ThisWorkbook.Sheets("abc")
' I guess New.Xlsm contain Macros and sheet ABC
set DataSheet = Activeworkbook.Sheets("Data")
and now use.. 


With NewXlsm
.cells(......)
With Datasheet
.cells(...)
End With
End With
[/pre]
to avoid swapping randomly between both sheet..


Regards,

Deb
 
Hi Sachin ,


To add to what has already been posted , I'd like to mention a method rather than any specifics ; there is a saying that you cannot control what you cannot measure.


The first thing to do when troubleshooting is to measure ; to do this , put the following statement liberally in your procedure :


Debug.Print "For Loop #1" & Time


Instead of "For Loop #1" use the names of the other constructs , such as "Do Until Loop #1". Put this statement both before and after a loop.


Once the procedure has completed , analyse the printouts in the Immediate Window , and see which part of the procedure is taking the most time ; shaving 15 seconds off something that is taking 15 minutes is not really going to help. At the same time , taking even 2 minutes off something that is taking 5 minutes is also not going to help !


If you can copy + paste the results of these Debug.Print statements , it can help us analyse the procedure , since we cannot do the same ( we do not have the data ).


Narayan
 
Hi All, thanks a lot for your great support & valuable time.


Extremely sorry for such a late reply, stuck with another work.


I will follow all the steps advised by you experts & will share the results.


Once again, thanks a lot & have a nice day.
 
@Dhamo Sir, I am not allowed to upload any file from the office.


@ Luke Sir, I will not be able to upload any file, but I will try to give the description of the files used


As advised by you I am trying to define all the variable used.


@ Debraj Sir, thanks a lot for the help, I am trying what you have advised me, will share the results.


@ Narayan Sir, thanks a lot for the help & explaining things in such a simple manner.

I am trying Debug Print method, 1 loop gave me run time of 20 minutes.


There are 3 loops used in the macro, I am getting time for all the loops.

I did some silly mistake while doing debug.print, so when I marked all the 3 loops, it gave me run time of 1 minute !


The macro is using Do Untill loops, it was my mistake while posting.


It just amazes me that all you experts are helping me so much that too with incomplete information.


Thanks a lot once again, have nice day.


Posting file details shortly.


Sir please delete my blank posts, this happened by mistake.
 
Details of the files used


Windows("New.xlsm")

This file has all the macros required to run this particular report.


I have copied the part which is giving me problem in another file.


I am trying to redesign that module, so for testing purpose using it as a new macro.


Why I need Windows("New.xlsm") open.

This file has a tab named "abc". In the "abc" tab I have a pivot table.


This pivot table is liked to workbook("data") workSheets("Data").


---------------------------------------------------------------------------------------


About Data tab in the data file.

All the values are supposed to be updated in this tab.

There are more than 100 columns in the file.

At present the last used row is 900, everyday I add 10 rows (approx).


This particular macro updates 10-12 columns only.

The columns in the data tab have text values, number values, & formulas.


Thanks.


Sachin
 
You must log in or register to reply here.
Back
Top