0

I need your help optimizing this macro in Excel. I'm using it to generate data for labels for chemotherapy drugs in our hospital. The macro works fine right now, but sometimes it takes a long time to generate. It's a non profit project and of course I get no help from the management. I'd be grateful for any suggestion or help.

Dim i, iLastRow, d As Integer
Dim date1, date2 As Date
Dim oLastRow As ListRow
Dim srcRow As Range
Dim date_tabela As Date
Dim ile_dawek As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.StatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
date1 = Worksheets("Program").Range("E2")
date2 = Worksheets("Program").Range("E3")
iLastRow = Worksheets("Program").ListObjects("Program").ListRows.Count + 6
For i = 7 To iLastRow
date_tabela = Cells(i, 4).Value
ile_dawek = Cells(i, 11).Value 
    If date_tabela >= date1 And date_tabela <= date2 Then
        For d = 1 To ile_dawek
            Set srcRow = Worksheets("Program").ListObjects("Program").Range.Range(Cells(i - 5, 1), Cells(i - 5, 36))
            Set oLastRow = Worksheets("Etykiety").ListObjects("Etykiety_druk").ListRows.Add()
            srcRow.Copy
            oLastRow.Range.PasteSpecial xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False

        Next
     End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = True
Application.EnableEvents = True
ActiveWorkbook.Save
End Sub
  • 1
    optimize you say? So it already works? Check out codereview.stackexchange! – Raystafarian May 7 '16 at 10:11
2

One way to speed up execution is to avoid recomputing the same values repeatedly in a loop.

Example:

Worksheets("Program").ListObjects("Program").Range

Assign it to a variable (example:programRange) and use the variable to do the subrange selection. You can do the same with the oLastRow expression.

Second, as some computations depend on the date comparison, you can avoid the computation of values that you do not need if the test fails. You can set 'ile_dawek' inside the IF statement.

There are surely other optimisations but they require more analysis.

Of course, make the assignments before the loop(s).

| improve this answer | |
  • 1
    I second this idea. You should avoid as much computing as possible within a loop and try to implement only iterations of a variable that holds the computed value. I have no proof though on my end to prove this – Prasanna May 7 '16 at 1:01
  • 1
    My first thought would be to just read the entire thing into an array and do your looping there.. – Raystafarian May 7 '16 at 10:12
0

One quick thing

Dim i, iLastRow, d As Integer
Dim date1, date2 As Date
Dim oLastRow As ListRow
Dim srcRow As Range
Dim date_tabela As Date
Dim ile_dawek As Integer

The multi-declared variables are not given a type, only the last one is - you need

Dim i as long, iLastRow as long, d as long

When you don't define your variable, VBA will declare it as a Variant, which are objects:

Performance. A variable you declare with the Object type is flexible enough to contain a reference to any object. However, when you invoke a method or property on such a variable, you always incur late binding (at run time). To force early binding (at compile time) and better performance, declare the variable with a specific class name, or cast it to the specific data type.

By not declaring variables, you could possibly be paying a penalty.

| improve this answer | |
0

To optimize your code there are some general rules:
- use local variables instead of fully qualified references
- declare variables with proper types, not variants
- in loops, move code to the outside of the loop which is invariant to the looping variable

For instance, the data which you copy is invariant to the loop over the number of label you want to print. So, you copy the data only once (into the clipboard) and reuse it multiple times.

If you look through my code suggestion, you will find that I haven't followed the rules completely; you should specify the exact type for the variable oLabels.

Then there was a well hidden source of error when using date_tabela = Cells(i, 4).Value. Cells here is dependent on the context. I have replaced it with .Cells which defines the context as the Worksheet("Program").

Resetting CutCopyMode is merely cosmetic, you can do it once only at the end.

The code looks like this now:

Sub print_doses()
    Dim i As Integer, iLastRow As Integer
    Dim date1 As Date, date2 As Date
    Dim oLastRow As ListRow
    Dim srcRow As Range
    Dim date_tabela As Date
    Dim d As Integer, ile_dawek As Integer
    Dim oLabels

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = False
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False

    Set oLabels = Worksheets("Etykiety").ListObjects("Etykiety_druk").ListRows
    With Worksheets("Program")
        date1 = .Range("E2")
        date2 = .Range("E3")
        iLastRow = .ListObjects("Program").ListRows.Count + 6
        For i = 7 To iLastRow
            date_tabela = .Cells(i, 4).Value
            If date_tabela >= date1 And date_tabela <= date2 Then
                ile_dawek = .Cells(i, 11).Value
                Set srcRow = .ListObjects("Program").Range.Range(Cells(i - 5, 1), Cells(i - 5, 36))
                srcRow.Copy
                For d = 1 To ile_dawek
                    Set oLastRow = oLabels.Add()
                    oLastRow.Range.PasteSpecial xlPasteValuesAndNumberFormats
                Next
            End If
        Next i
        Application.CutCopyMode = False
    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = ""
    Application.EnableEvents = True
    ActiveWorkbook.Save
End Sub
| improve this answer | |

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.