CODEWITHSUNDEEP
vbaexcel-2007excel-2010
BadgerBeaz
BadgerBeaz

Reputation: 393

VBA Excel Code Running Much slower in 2010 than 2007

I have some code that runs fine in Excel 2007 but when used in Excel 2010 takes about ten times longer to run and causes the whole taskbar/other programs to be unresponsive.

I don't believe hardware is the problem because the computer running Excel 2007 is a Pentium 4 with 2 gigs of ram, while the computer running 2010 is an i7 with 8 gigs of ram.

Here is the code itself:

Sub Macro6()
    With Application
        .ScreenUpdating = False 'Prevent screen flickering
        .Calculation = xlCalculationManual 'Preventing calculation
        .DisplayAlerts = False 'Turn OFF alerts
        .EnableEvents = False 'Prevent All Events
    End With

    Dim i As Integer
    Dim j As Integer
    Dim Anc As String
    Dim MSA As String

    j = 1

    Do
        i = 0
        MSA = ActiveCell
        Selection.Copy
        Sheets("Sheet1").Select
        ActiveCell.Offset(0, -2).Select
        ActiveSheet.Paste
        ActiveCell.Offset(0, 2).Select
        Sheets("wip").Select
        Do
            i = i + 1
            ActiveCell.Offset(0, 1).Select
            Anc = ActiveCell.Offset(-j, 0)
            Selection.Copy
            Sheets("Sheet1").Select
            ActiveCell.Offset(0, -1) = Anc
            ActiveCell.Offset(0, -2) = MSA
            ActiveSheet.Paste
            ActiveCell.Offset(1, 0).Select
            Sheets("wip").Select

        Loop Until IsEmpty(ActiveCell.Offset(0, 1))
        j = j + 1
        ActiveCell.Offset(1, -i).Select
    Loop Until IsEmpty(ActiveCell)

    'Speeding Up VBA Code
    With Application
        .ScreenUpdating = True 'Prevent screen flickering
        .Calculation = xlAutomatic 'Preventing calculation
        .DisplayAlerts = True 'Turn OFF alerts
        .EnableEvents = True 'Prevent All Events
    End With
End Sub

The code does what I want it to, but I am concerned as to why in 2010 there is such a difference in running time?

Upvotes: 0

Views: 2962

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149305

Is this what you are trying to do?

Option Explicit

Sub Sample()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim i As Long, j As Long, k As Long, lRow As Long, lCol As Long

    On Error GoTo Whoa

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

    '~~> Setting the worksheets to work with
    Set ws1 = Sheets("wip"): Set ws2 = Sheets("Sheet1")

    '~~> Setting the start cell in "Sheet1"
    k = 3

    With ws1
        '~~> Get the last row in Col A of "wip"
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        '~~> Get the last column in row 3 of "wip"
        lCol = .Cells(3, .Columns.Count).End(xlToLeft).Column

        '~~> Looping through rows in Col A in "wip"
        For i = 3 To lRow
            '~~> Looping through columns in the relevant row in "wip"
            For j = 3 To lCol + 1
                '~~> Writing output directly in "Sheet1"
                ws2.Cells(k, 1).Value = ws1.Cells(i, 1).Value
                ws2.Cells(k, 3).Value = ws1.Cells(i, 1).Offset(, j - 2).Value
                k = k + 1
            Next j
        Next i
    End With

LetsContinue:
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Upvotes: 2

Related Questions