PDA

View Full Version : perfomance VBA with loop



arnauddes
06-21-2018, 07:29 AM
Hello,

I have to run vba code with several loop.VBA work but very bad performance.

Anyone has some tips to reduce execution time of my vba code?




Sub macro()
'

' Declare variables'
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim wk_orderlines As Integer
Dim wk_tot_volume As Integer
Dim wk_proportion As String
Dim wk_LEG_store As String
Dim wk_comp_promo As String
Dim wk_sap_art As String
Dim wk_art_store As String
Dim wk_store_quantity As Double
Dim wk_store_quantity2 As Double
Dim wk_to_be_forecasted As String
Dim wk_delivery As Integer
Dim wk_colisage As Integer
Dim wk_average As Integer

'Clean SAS UP_LOAD Sheet
Application.ScreenUpdating = False
Sheets("LIST_TOV4").Select
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Clear
Range("A2").Select


' Start program
i = 1
k = 1
Sheets("LIST_TO").Select
Range("A2").Select
Do Until IsEmpty(ActiveCell)
Sheets("LIST_TO").Select
i = i + 1
wk_to_be_forecasted = ActiveSheet.Cells(i, 11).Value
If wk_to_be_forecasted = "Y" Then
wk_orderlines = ActiveSheet.Cells(i, 1).Value
wk_tot_volume = ActiveSheet.Cells(i, 12).Value
wk_comp_promo = ActiveSheet.Cells(i, 13).Value
wk_sap_art = ActiveSheet.Cells(i, 14).Value
wk_delivery = ActiveSheet.Cells(i, 10).Value
wk_average = ActiveSheet.Cells(i, 16).Value
wk_colisage = ActiveSheet.Cells(i, 9).Value

' Catch Stores
j = 1
Sheets("LIST_TOV2").Select
Range("A2").Select

Do Until IsEmpty(ActiveCell)
j = j + 1
wk_proportion = "0.008"
wk_store_sales = ""
wk_store_quantity = 0


Sheets("LIST_TOV2").Select
wk_LEG_store = ActiveSheet.Cells(j, 1).Value
wk_art_store = wk_sap_art & "/" & wk_comp_promo & "/" & wk_LEG_store

If wk_comp_promo = "non comp promo" Then
On Error Resume Next
wk_proportion = Application.WorksheetFunction.VLookup(Cells(j, 1), Sheets("PROPORTIONS").Range("A1:C200").Value, 3, False)
wk_store_quantity = wk_tot_volume * wk_proportion
wk_store_quantity2 = Application.WorksheetFunction.RoundUp(wk_store_quantity, 0)
On Error GoTo 0


Else
On Error Resume Next
wk_store_sales = Application.WorksheetFunction.VLookup(wk_art_store, Sheets("LIST_TOV4").Range("B1:I100000").Value, 8, False)
wk_colisage = Application.WorksheetFunction.VLookup(wk_art_store, Sheets("LIST_TOV4").Range("B1:G100000").Value, 6, False)
wk_store_quantity = (wk_store_sales / wk_delivery) / wk_colisage
wk_store_quantity2 = Application.WorksheetFunction.RoundUp(wk_store_quantity, 0)
On Error GoTo 0
End If

' Fill the upload sheet
k = k + 1
Sheets("LIST_TOV4").Select
Cells(k, 1).Value = wk_LEG_store + 10000
Cells(k, 2).Value = wk_orderlines
Cells(k, 3).Value = wk_store_quantity2
Sheets("LIST_TOV2").Select
ActiveCell.Offset(1, 0).Select
Loop
Else
End If

Sheets("LIST_TO").Select
ActiveCell.Offset(1, 0).Select
Loop

' Position cursor on top of all sheets
Sheets("LIST_TO").Select
Range("A1").Select
Sheets("PROPORTIONS").Select
Range("A1").Select
Sheets("LIST_TOV4").Select
Range("A1").Select
Sheets("LIST_TOV2").Select
Range("A1").Select
Sheets("LIST_TOV4").Select
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "Macro successfully ended"



End Sub



tx,

Kr,

Arnd

Paul_Hossler
06-21-2018, 07:50 AM
1. I added CODE tags to format your macro -- you can use the [#] icon to insert them next time


2. take a look at the FAQ -- link in my signature

3. Use Long, not Integer

4. Don't need to .Select something to act on it

5. Use Application.ScreenUpdating = False at the start

6. Someone will suggest using Arrays, but that can be for later

offthelip
06-21-2018, 04:10 PM
Your code has been written using multiple accesses to the worksheet, I am not in the slightest bit surprised that it takes a long time:
One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action.
So instead of writing a loop which loops down a range copying one row at a time which will take along time if you have got 50000 rows it is much quicker to load the 50000 lines into a variant array ( one worksheet access), then copy the lines to a variant array and then write the array back to the worksheet, ( one worksheet access for each search that you are doing),
I have a simple rule for fast VBA: NEVER ACCESS THE WORKSHEET IN A LOOP.

the way you have sent up your loops of looping until the active cell is empty isn't going to work well with variant arrays and is a very inefficient way of doing loops

Also it is completely unnecesary and usually makes for slow code to be continually selecting different sheets and cells.

Also it is much faster to use a variant arrays instead of Vlookup which accesses the worksheet .
So the good news is you can very easily speed up this code enormously, however to do a proper job of it you are going to need to completely rewrite it.
To my mind there is hardly a line of code which couldn't be improved on.

to put it simply,
1: get rid of all the selects , (use with worksheets instead)
2: load all the worksheets entirely in variant arrays using lastrow and lastcolumn to determine the size of the variant arrays
3: change the loop control for using
ActiveCell.Offset(1, 0).Select to a do loop from 1 to lastrow
4: define an output variant array, write the data into this array during the loop and then output the whole array at the end of the loop
I hope this helps.