CODEWITHSUNDEEP
vbaexcelmacros
Wayne Louwrens
Wayne Louwrens

Reputation: 23

VBA Macro is running extremely slowly

I have this Macro, and finally got it figured out, but it is running very slowly, and would take about 3 days to get through my one sheet of 800 000 lines, and I have 100 sheets. I would appreciate help in this regard.

Sub Calculate_Sheet()
   Dim orderSh As Worksheet
   Dim wiroSh As Worksheet
   Dim lastRow As Long, r As Long
   Dim pctComp As Double

 With ThisWorkbook
  'calculator
  Set orderSh = .Sheets("ORDER")
  'price list
  Set wiroSh = .Sheets("WiroA3C100gsmI100gsm20-22pp ")
End With

lastRow = wiroSh.Cells(Rows.Count, 3).End(xlUp).Row

For r = 2 To lastRow
pctComp = (r / 800000) * 100
Application.StatusBar = "Progress..." & " " & pctComp & " " & "% Complete"

  'copy from price list to calculator
  orderSh.Range("f4") = wiroSh.Range("c" & r)
  orderSh.Range("f5") = wiroSh.Range("d" & r)
  orderSh.Range("f6") = wiroSh.Range("e" & r)
  orderSh.Range("f7") = wiroSh.Range("f" & r)
  orderSh.Range("f8") = wiroSh.Range("g" & r)
  orderSh.Range("f9") = wiroSh.Range("h" & r)
  orderSh.Range("f10") = wiroSh.Range("i" & r)
  orderSh.Range("f11") = wiroSh.Range("j" & r)
  orderSh.Range("f12") = wiroSh.Range("k" & r)
  orderSh.Range("f13") = wiroSh.Range("l" & r)

  'copy result
  wiroSh.Range("m" & r).Value = orderSh.Range("F14")
Next r

 End Sub

Upvotes: 2

Views: 1571

Answers (5)

Wayne Louwrens
Wayne Louwrens

Reputation: 23

so I took the suggestion of the Arrays, but I am missing something. Here is how I tweaked the VBA code, put no values are being inserted anywhere?

 Sub Calculate_Sheet()

Dim orderSh As Worksheet
Dim wiroSh As Worksheet
Dim lastRow As Long, r As Long
Dim pctComp As Double
Dim Arr1 As Variant
Dim Arr2 As Variant

With ThisWorkbook

'calculator
  Set orderSh = .Sheets("ORDER")

'price list
  Set wiroSh = .Sheets("WiroA3C100gsmI100gsm20-22pp ")

 End With

 Arr1 = wiroSh.Range("C1:M800001")
 Arr2 = orderSh.Range("F4:F14")

lastRow = wiroSh.Cells(Rows.Count, 3).End(xlUp).Row

For r = 2 To lastRow

'display the row and percentage each 1000 rows
  If r Mod 1 = 0 Then
     Application.StatusBar = "Row = " & r & Format(r / lastRow, " #0.00%")
  End If

'copy from price list to calculator
  Arr2(1, 1) = Arr1(r, 1)
  Arr2(2, 1) = Arr1(r, 2)
  Arr2(3, 1) = Arr1(r, 3)
  Arr2(4, 1) = Arr1(r, 4)
  Arr2(5, 1) = Arr1(r, 5)
  Arr2(6, 1) = Arr1(r, 6)
  Arr2(7, 1) = Arr1(r, 7)
  Arr2(8, 1) = Arr1(r, 8)
  Arr2(9, 1) = Arr1(r, 9)
  Arr2(10, 1) = Arr1(r, 10)

'copy result
  Arr1(r, 11) = Arr2(11, 1)

Next r


 End Sub

Upvotes: 0

Paul S
Paul S

Reputation: 190

There is absolutely no reason whatsoever to ever turn screen updating off. its a technique used to speed up inefficient code, if your code isnt inefficient you dont need to worry about screen updating.... ever.....

The theory is very simple.. Dont EVER access/use a range in your code unless absolutely necessary....

Instead dump the entire sheets data into an array and work from that, not only is it fast.... i mean super fast, you can repopulate an entire sheet (that is 32000 columns and 1 million rows) immediately using an array......

and you use the exact same logic to work with the array as you would with a range so you really have no excuse..

Dim Arr as variant
Arr = Sheet1.Range("A1:Z100")

now instead of Sheet1.Range("A1").value just use Arr(1,1) to access the value

and updating the sheet with the array is just as easy

Sheet1.Range("A1:Z100").value = arr

its as simple as that, its fast its easy and its the way you SHOULD do it unless its just something small your working on but even then, better to practice the best methods right?

1 thing to note is when you put the array values back to the sheet, you need to use a range that is the same size or larger than the array........ or else it will just fill the range you specify.

Upvotes: 0

PaichengWu
PaichengWu

Reputation: 2689

There is a feature in excel called "Data Table". This feature could help you without writing VBA. But, sorry, I cannot find the explaination in English.

Upvotes: 0

Luboš Suk
Luboš Suk

Reputation: 1546

Also you can try to copy only single range, instead of multiple ranges. I think it can slight increase your performance.

I think, you can replace this

  orderSh.Range("f4") = wiroSh.Range("c" & r)
  orderSh.Range("f5") = wiroSh.Range("d" & r)
  orderSh.Range("f6") = wiroSh.Range("e" & r)
  orderSh.Range("f7") = wiroSh.Range("f" & r)
  orderSh.Range("f8") = wiroSh.Range("g" & r)
  orderSh.Range("f9") = wiroSh.Range("h" & r)
  orderSh.Range("f10") = wiroSh.Range("i" & r)
  orderSh.Range("f11") = wiroSh.Range("j" & r)
  orderSh.Range("f12") = wiroSh.Range("k" & r)
  orderSh.Range("f13") = wiroSh.Range("l" & r)

with something like this

orderSh.Range(orderSh.cells(4,"F"),orderSh.cells(13,"F")) = wiroSh.Range(wiroSh.cells(r,"C"),wiroSh.cells(r,"l"))

And as j.kaspar mentioned, usage of application.screenupdating = false is great idea, but i would strongly recomend to use something like this on the begining of your macro

Dim previousScreenUpdating as boolean
previousScreenUpdating = application.screenUpdating
application.screenUpdating = false

and this on the end of your macro

application.screenUpdating = previousScreenUpdating

Which can help you, when you have nested function in which you setting multiple screenUpdatings...

And also, if you have some formulas on any sheet, make something similar with (on the begining)

Application.Calculation = xlCalculationManual

and this on the end of code

Application.Calculation = xlCalculationAutomatic

And one last, if you have some event listeners, consider using this (same as with screen updating)

application.enableEvents

Upvotes: 3

j.kaspar
j.kaspar

Reputation: 761

Use Application.ScreenUpdating = False on the beginning, and Application.ScreenUpdating = True at the end of the macro.

It will run multiple times faster, when the screen is not being updated. But keep in mind, that 800.000 lines and 100 sheets is a lot and it will take "some" time...

Upvotes: 1

Related Questions