Reduce the time of running the macro

RAJESH1960

RAJESH1960

Banned for repeated rules violations
Joined
Mar 26, 2020
Messages
2,313
Office Version
  1. 2019
Platform
  1. Windows
Hello Experts

I have this file which runs through a long process to get the final result. I have recorded several macros along with the help of macros I got through this board. The problem is it takes at least 2 minutes to get the result. I am not able to figure out why the macro is running so slow. With your expert advice, I am sure I will be able to edit and run the macro in just a few seconds. I get an error when I try to edit the multiple select options in the code

The sheet “Original” is the raw data pasted. “SheetF” is the final result of the data. To get the result the macro runs through different sheets to get the expected result. “GetData” is the macro to get the result and “ClearData” is to clear the old data so that a new data can be pasted. “ClearData” also inserts once again, different formulas in the “SheetB” which were deleted while getting the data. In short, I am arranging the data of Original sheet in the format as shown in SheetF with this code.
I am sharing the link of a sample file.
drive.google.com

Test.xlsm

drive.google.com drive.google.com
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
Your file is almost completely 'Selects'. That is a major impact on performance.

I have started the 'ClearData' shortening to give an example of how to get rid of the 'selects':

VBA Code: 
Sub ClearData()
'
    Sheets("Bank").Cells.Clear
'
    Sheets("A").Cells.Clear
'
    Sheets("B").Range("A3:G" & Sheets("B").Range("A" & Rows.Count).End(xlDown).Row).ClearContents
'
    Sheets("E").Cells.Clear
'
    Sheets("Z").Cells.Clear
'
    Sheets("F").Range("B2:BE5000").ClearContents
'
    Sheets("B").Range("I3:I" & Sheets("B").Range("I" & Rows.Count).End(xlDown).Row).ClearContents
'
    Sheets("B").Range("K3:BD" & Sheets("B").Range("P" & Rows.Count).End(xlDown).Row).ClearContents
'
    Sheets("Formulas").Range("I3").Copy Sheets("B").Range("I3")
'
    Sheets("B").Range("I3:I" & Sheets("B").Range("I" & Rows.Count).End(xlDown).Row).FillDown
'
'   etc...
'
    Sheets("Formulas").Select
    Range("B2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    ActiveSheet.Previous.Select
    Range("K3").Select
    ActiveSheet.Paste
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.FillDown
    Range("K3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("I3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A3").Select
    Sheets("Original").Select
    Range("A1:C1").Select
End Sub

Your other module suffers the same. :(
 
Upvote 0
johnnyL said:
Your file is almost completely 'Selects'. That is a major impact on performance.

I have started the 'ClearData' shortening to give an example of how to get rid of the 'selects':

VBA Code: 
Sub ClearData()
'
    Sheets("Bank").Cells.Clear
'
    Sheets("A").Cells.Clear
'
    Sheets("B").Range("A3:G" & Sheets("B").Range("A" & Rows.Count).End(xlDown).Row).ClearContents
'
    Sheets("E").Cells.Clear
'
    Sheets("Z").Cells.Clear
'
    Sheets("F").Range("B2:BE5000").ClearContents
'
    Sheets("B").Range("I3:I" & Sheets("B").Range("I" & Rows.Count).End(xlDown).Row).ClearContents
'
    Sheets("B").Range("K3:BD" & Sheets("B").Range("P" & Rows.Count).End(xlDown).Row).ClearContents
'
    Sheets("Formulas").Range("I3").Copy Sheets("B").Range("I3")
'
    Sheets("B").Range("I3:I" & Sheets("B").Range("I" & Rows.Count).End(xlDown).Row).FillDown
'
'   etc...
'
    Sheets("Formulas").Select
    Range("B2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    ActiveSheet.Previous.Select
    Range("K3").Select
    ActiveSheet.Paste
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.FillDown
    Range("K3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("I3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A3").Select
    Sheets("Original").Select
    Range("A1:C1").Select
End Sub

Your other module suffers the same. :(
Click to expand...
Thanks Johnnyl. I have tried to change the get data replacing the selects. But I keep getting errors. My original data is 2000-3000 rows and it takes more than 10 minutes to get the result. My skills are so limited that I will need help me to correct the selects in the GetData macro also. Your clear data code cleared the sheet in less than 5 seconds. Iwould really appreciate it if you will give me your advice to change the code at 3 places in the GetData Macro.
'this range needs to be changed
Rich (BB code): 
Mx = Application.Max(Range("K3:K2000"))
Rich (BB code): 
Selection.AutoFill Destination:=Range("F2:G2000")
Rich (BB code): 
Range("F2:G2000").Select
 
Upvote 0
JohnnyL. I keep getting error at the line I try to shorten the code. The clearData code which you partially edited is faster than the previous code. But the problem still persists. Even with your edited code, It takes more over around 5-10 minutes to clear the data in the original data base where there are 300 -2000 rows.
 
Upvote 0
RAJESH1960 said:
JohnnyL. I keep getting error at the line I try to shorten the code. The clearData code which you partially edited is faster than the previous code. But the problem still persists. Even with your edited code, It takes more over around 5-10 minutes to clear the data in the original data base where there are 300 -2000 rows.
Click to expand...

Try this, Don't blink! ;)

VBA Code: 
Sub ClearDataV2()
'
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
'
    Dim LastTableRow    As Long
    Dim ColumnLetter    As String
'
    Sheets("Bank").Cells.Clear
    Sheets("A").Cells.Clear
    Sheets("B").Range("A3:G3", Sheets("B").Range("A3:G3").End(xlDown)).ClearContents
    Sheets("B").Range("I3", Sheets("B").Range("I3").End(xlDown)).ClearContents
    Sheets("B").Range("K3:BD3", Sheets("B").Range("K3:BD3").End(xlDown)).ClearContents
    Sheets("E").Cells.Clear
    Sheets("Z").Cells.Clear
    Sheets("F").Range("B2:BE5000").ClearContents
'
    Sheets("Formulas").Range("I3").Copy Sheets("B").Range("I3")
    Sheets("B").Range("I3", Sheets("B").Range("I3").End(xlDown)).FillDown
'
    Sheets("B").Select
'
    ColumnLetter = Split(Sheets("B").Range("K2").End(xlToRight).Address, "$")(1)
    LastTableRow = Sheets("B").Range("K3", "K3").End(xlDown).Row
'
    Sheets("B").ListObjects.Add(xlSrcRange, Sheets("B").Range("$K$2:$" & ColumnLetter & "$" & LastTableRow), , xlYes).Name = "Table1"
'
    Sheets("Formulas").Range("B2", Sheets("Formulas").Range("B2").End(xlToRight)).Copy Sheets("B").Range("K3")
'
    With Sheets("B").Range("I3", Sheets("B").Range("I3").End(xlDown))
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
'
    Sheets("Original").Select
    Range("A1:C1").Select
'
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Wow!! Awesome!! JohnnyL, You are really too good man. You understood the working of the code without me explaining it to you. I knew you could do it. I tested the code in the test data and it works perfect. Will try it tonight on a larger data. I hope the Getdata macro runs with the data which you converted it into a table in sheetB. I will try to shorten the macro in GetData the same way as you did with ClearData. Should I add these lines in the GetData macro too.? Will need your expertise again... I will try myself for a day or two, if not will message again. Please keep in touch. Thanks a ton.?
Rich (BB code): 
Application.ScreenUpdating = False
    Application.Calculation = xlManual
 
Upvote 0
JohnnyL. When I tried to run the GetData code, I got an error - "Run time error 1004. Application defined or object defined error". I am getting the error at this line in the GetData macro.
Sheets("E").Range("A3:AT3").Resize(Mx).Value = Range("K3:BD3").Resize(Mx).Value
Can it be due to the table..? It is maybe affected by the change in ClearData code which has a table.
Still trying to figure it out .....
 
Upvote 0
Check this out. The problem is in the B sheet and it is getting only one (out of 6 in this case) result in columns K:BD others are left blank. The ClearData code is changing the view of the sheet and hence the GetData code is getting an error I assume.
Test.xlsm
 
Upvote 0
Ok, I'll have to take another look at it tomorrow.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
VBA/Formula to only run lookup if a cells value is a match
Replies
0
Views
354
Benjo83
B
S
  • Question
Formula for pulling the counts on items in i different locations but with same name
2
Replies
11
Views
189
svis89
S
G
  • Question
Open workbooks in folder and run Macro in each book
Replies
7
Views
403
glynn1969
G
A
  • Question
Macros for cleaning excel file
2
Replies
18
Views
435
jolivanes
jolivanes
AndyTampa
  • Solved
Limit Quick Tasks macro to a specific worksheet
Replies
4
Views
93
mumps
mumps

Forum statistics

Threads
1,215,452
Messages
6,124,916
Members
449,195
Latest member
Stevenciu

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top