VBA Maco Code Taking Long Time To Run

lizzie5 · May 4th 2012

I have a macro below that’s used for converting/displaying data in a specific format. There are two triggers in the macro - it takes a specific course of action based on the value of another cell (AF1). If cell AF1 = 1 and it runs the code I have underneath that If statement, it takes a LONG TIME to run. If cell AF1 = 2 then the code runs in a reasonable amount of time.

If I don’t touch my computer at all, it takes at least 7 minutes to run. If I have a lot of applications going or try to do something else, it nearly freezes and takes much longer (just to note, the macro still runs successfully in that case).

Below is the code. I’m still a macro novice; is there more efficient code I can use that would produce the same results?

Code

Sub EISpricecheck()
'copies EIS tab pricing contents, pastes on CHECK tab. Here I will check to see if there are 1 or 2 sets of prices.
'This also concatenates discount key & applies/wknd/wkday values
 
'
Application.ScreenUpdating = False
    'clear contents from "check" tab, but leaves formulas on right intact
    Sheets("check").Select
    Columns("A:AB").Select
    Selection.ClearContents
   
    'copies "EIS" tab data and pastes to "check" tab
    Sheets("EIS").Select
    Columns("A:AB").Select
    Selection.Copy
    Sheets("check").Select
    Range("A1").Select
    ActiveSheet.Paste
   
   
'check if there are 1 or 2 sets of prices:
    'If 2 sets of prices, add concatenate formula in column D
    If Sheets("check").Range("AF1") = 2 Then
        'place concatenate formula in column D
        Range("D1").Select
        Do While IsEmpty(ActiveCell.Offset(0, 1)) = False
            ActiveCell.FormulaR1C1 = ActiveCell.Offset(0, -3) & ActiveCell.Offset(0, -1)
            ActiveCell.Offset(1, 0).Select
        Loop
        Range("D:D").EntireColumn.AutoFit
    End If
   
    'If 1 set of prices, replace "weekend" with "prices" and "weekday" with BLANK, then add concatenate formula in col D
    If Sheets("check").Range("AF1") = 1 Then
        Dim Target, cell As Range
        Dim weekday, weekend, prices As String
            weekday = "weekday"
            weekend = "weekend"
 
            Set Target = Sheets("check").Range(Range("C1"), Range("C65536").End(xlUp))
            For Each cell In Target
                If cell.Value = weekday Then cell.Value = ""
                If cell.Value = weekend Then cell.Value = "prices"
            Next cell
       'add concat formula
        Range("D1").Select
        Do While IsEmpty(ActiveCell.Offset(0, 1)) = False
            ActiveCell.FormulaR1C1 = ActiveCell.Offset(0, -3) & ActiveCell.Offset(0, -1)
            ActiveCell.Offset(1, 0).Select
        Loop
        Range("D:D").EntireColumn.AutoFit
    End If
   
   
Application.ScreenUpdating = True
 
End Sub

Display More

trunten · May 6th 2012

Re: Macro taking a very long time to run, possible to make it more efficient?

try:

Code

Option Explicit


Sub EISpricecheck()
    Const weekday As String = "weekday"
    Const weekend As String = "weekend"
    
    Dim arr() As Variant
    Dim formulaDone As Boolean
    Dim i As Long
    
    Application.ScreenUpdating = False
    formulaDone = False
    With Sheets("check")
        .Range("A:AB").ClearContents
        Sheets("EIS").Columns("A:AB").Copy .Range("A1")
        If .Range("AF1") = 2 Then
            formulaDone = True
            .Range("D1", .Range("D1").End(xlDown)).Formula = "=R[]C[-3]&R[]C[-1]"
        End If
        If .Range("AF1") = 1 Then
            With .Range("C1", .Cells(.Rows.Count, "C").End(xlUp))
                arr = .Value
                For i = 1 To UBound(arr)
                    If arr(i, 1) = weekday Then
                        arr(i, 1) = ""
                    ElseIf arr(i, 1) = weekend Then
                        arr(i, 1) = "prices"
                    End If
                Next i
                .Value = arr
            End With
            If Not formulaDone Then
                .Range("D1", .Range("D1").End(xlDown)).Formula = "=R[]C[-3]&R[]C[-1]"
                formulaDone = True
            End If
        End If
        If formulaDone Then
            With .Range("D1", .Cells(.Rows.Count, "D").End(xlUp))
                .Value = .Value
            End With
        End If
        .Columns("D:D").AutoFit
    End With
    Application.ScreenUpdating = True
End Sub

Display More

Dave Hawley · May 6th 2012

Re: Macro taking a very long time to run, possible to make it more efficient?

Consider also;

Code

With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
End With


'YOUR CODE


With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
End With

Display More

More tips here: Optimize Slow VBA Code

trunten · May 6th 2012

Re: Macro taking a very long time to run, possible to make it more efficient?

If you use Dave's suggestion, in my code change:

Code

If formulaDone Then
    With .Range("D1", .Cells(.Rows.Count, "D").End(xlUp))
        .Value = .Value
    End With
End If

to

Code

If formulaDone Then
    With .Range("D1", .Cells(.Rows.Count, "D").End(xlUp))
        .Calculate
        .Value = .Value
    End With
End If

lizzie5 · May 7th 2012

Re: VBA Maco Code Taking Long Time To Run

Thank you both for your suggestion. Dave's suggestion runs the fastest, but it seems to cause the result to output incorrectly. The value in cell AF1 is a formula, not sure if that is affected by the CalcuationManual part of the code (I'm not too familiar with that yet).

I tried trunten's code and it's pretty quick and a HUGE improvement from my original code.

Thanks!!!

VBA Maco Code Taking Long Time To Run

Participate now!

Share