Slow VB Code

[duke1509]

Hi Everyone,

I have this code below, but it is running extremely slow, by my calculations it would take 3 days to complete one sheet. Do you perhaps have suggestions on how to speed it up, as I have more than 100 sheets to get through please.

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

 

[dave3009]

In each loop you are writing to the same cells in orderSh, just overwriting each time the loop runs and your code suggests that may be up to 800,000 rows. Is there any reason for that as it would seem more logical to just write the last row of wiroSh into orderSh (transposed) and be done with it.

 

[RoryA]

I'm assuming F14 contains a formula and you pass different inputs for each row? If so, it may be more efficient to actually put formulas into the cells on the destination sheet.

Also, updating the statusbar for each row will slow things down, as will reading/writing one cell at a time. You could try this:

Sub Calculate_Sheet()

    Dim orderSh               As Worksheet
    Dim wiroSh                As Worksheet
    Dim lastRow As Long, r    As Long
    Dim pctComp               As Double

    Application.ScreenUpdating = False
    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
        ' don't update for every pass - that will be slow
        If r Mod 10000 = 0 Then Application.StatusBar = "Progress..." & " " & pctComp & " " & "% Complete"

        'copy from price list to calculator
        orderSh.Range("f4:F13").Value2 = Application.WorksheetFunction.Transpose(wiroSh.Range("c" & r).Resize(1, 10))

        'copy result
        wiroSh.Range("m" & r).Value = orderSh.Range("F14")
    Next r
    Application.ScreenUpdating = True
End Sub

 

[duke1509]

Hi Rory,

Yes F14 has a formula which is part of a excel calculator, in which values are inserted from "wiro" sheet in to the calculator, and in turn the answer is transferred back into a column corresponding with qty input.

 

[RoryA]

Also cross-posted here: excel - VBA Macro is running extremely slowly - Stack Overflow