Small Macro running slow

[Stephenosn]

Hello all,

I'm having trouble with a small micro running much slower than I believe it should. Please see the code bellow.

Sub NBill_Click()

Dim NBill As Integer
    NBill = MsgBox("This action will update the previous percent complete and the total billed to date?", _
    vbOKCancel, "NEW BILLING PERIOD?")
    If NBill = vbCancel Then
        Exit Sub
    End If
     
    'Add Amount to bill this period to total amount billed to-date
    Dim ABill As Object
          For Each ABill In Range("J5:J60")
              ABill.Value = ABill.Offset(0, 0).Value _
                  + ABill.Offset(0, -1).Value
          Next
'Replace previous percent complete with percent completed to-Date
    Dim rng As Range
        Set rng = Worksheets("SOV").Range("H5:H60")
            Worksheets("SOV").Range("F5").Resize _
            (rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
End Sub

I have walked through the code and it appears the problem is with the following procedure.

'Add Amount to bill this period to total amount billed to-date    Dim ABill As Object
          For Each ABill In Range("J5:J60")
              ABill.Value = ABill.Offset(0, 0).Value _
                  + ABill.Offset(0, -1).Value
          Next

Please let me know if there is something I'm missing here that would speed this macro up or a better way to write the code.

Thank you for having a look,

John

 

[JoeMo]

Have you tried turning off calculation and screen updating at the start of your procedure, then turn them back on just before the end sub?

 

[Stephenosn]

Joe,

I have not tried that (because I don't know how). I will try to figure it out and give it a shot. Thank you for the advice.

John

 

[S.H.A.D.O.]

Put...

    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
    End With

...at the top after the Dim's, and...

    With Application
        .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With

...at the bottom before the End Sub.

I hope this helps!

 

[JoeMo]

Joe,

I have not tried that (because I don't know how). I will try to figure it out and give it a shot. Thank you for the advice.

John

Add this after the first Dim line:

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

and this just before the End Sub line

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

 

[Stephenosn]

Excellent. I'm going to give these a try and I'll post back.

Thank you!

 

[Stephenosn]

I have added the previous suggestions to my code. I know have the following.

Sub NBill_Click()

Dim NBill As Integer
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With
    NBill = MsgBox("This action will update the previous percent complete and the total billed to date. Are you sure you would like to proceed", _
    vbOKCancel, "NEW BILLING PERIOD?")
    If NBill = vbCancel Then
        Exit Sub
    End If
     
    'Add Amount to bill this period to total amount billed to-date
    Dim ABill As Object
          For Each ABill In Range("J5:J44")
              ABill.Value = ABill.Offset(0, 0).Value _
                  + ABill.Offset(0, -1).Value
          Next
'Replace previous percent complete with percent completed to-Date
    Dim rng As Range
        Set rng = Worksheets("SOV").Range("H5:H44")
            Worksheets("SOV").Range("F5").Resize _
            (rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With
End Sub

There is still a several second delay after pressing the button. I've closed and opened Excel many times as well as restarted my computer.

The following code on another button has no delay at all.

Sub Add_Retention()Dim TotCell As Object
Dim AddRetention As Integer
    AddRetention = MsgBox("This action will add the retention value to any job codes at 90% completion as well as change them to show 100% complete. Are you sure you would like to do this?", _
    vbOKCancel, "ADD RETENTION?")
    If AddRetention = vbCancel Then
        Exit Sub
    End If
    
    For Each TotCell In Range("J5:J44")
        If TotCell.Offset(0, -2).Value = 90 Then
               TotCell.Value = TotCell.Offset(0, 0).Value + TotCell.Offset(0, 2).Value
        End If
    Next
    For Each TotCell In Range("L5:L44")
        If TotCell.Offset(0, -4).Value = 90 Then
            TotCell.Value = "0"
        End If
    Next
    For Each TotCell In Range("H5:H44")
        If TotCell.Offset(0, 4).Value = 0 Then
            TotCell.Value = "100"
        End If
    Next


End Sub

Any more ideas?

 

[JoeMo]

Is there any event code in the workbook?

 

[Stephenosn]

There are two userforms with plenty of code behind them. They interact with another sheet though. Would this be causing a problem do you think?

 

[Rhodie72]

There are two userforms with plenty of code behind them. They interact with another sheet though. Would this be causing a problem do you think?

No, I don't imagine it does. I think the problem is that you are referencing data directly on the sheet instead of lifting it into memory first and operating on the array of data in memory instead. you have a set array in

    For Each ABill In Range("J5:J44")
        ABill.Value = ABill.Offset(0, 0).Value _
        + ABill.Offset(0, -1).Value
    Next

If you instead read both arrays into RAM then did everything in RAM instead of in the sheet, then it would work Vastly faster. With a capital V.

I've condensed your code a little to streamline it and maybe it will help a little... try it on a dummy of your workbook and see if it helps improve the speed. There are comments in the code which become apparent as you read it in the VBE.

Sub NBill_Click()
'''     User variables' dimension declaration
Dim Rng As Range, NBill As String, ABill As Object, mySht As Worksheet
'Dim myArr1 As Variant, myArr2 As Variant, aBill as integer, n as long

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        '   Long range parenthetical With... End With procedure Begins
        
'''     Variable definition declarations
        Set Rng = mySht.Range("H5:H44")
        Set mySht = Worksheets("SOV")
        'myArr1 = Range("J5:J44"): _
        myArr2 = Range("I5:I44")

        NBill = "This action will update the previously completed percentage" & Chr(13) & _
                "and the total amount billed to date." & Chr(13) & _
                "Are you sure you want to proceed?"

        Select Case MsgBox(NBill, vbOKCancel + vbQuestion, "NEW BILLING PERIOD?")

'''     Rhodie72: Reading data directly to 2 arrays would be beneficial _
                  Instead of working on the sheet 78 times.

            Case vbOK
'           Add Amount to bill this period to total amount billed to-date. _
            Reads directly from sheet 39 times _
            try using the following code instead:

'            For n = LBound(MyArray) To UBound(MyArray)
'                ABill = ABill + ABill.Offset(0, -1).Value
'            Next n
            
                For Each ABill In Range("J5:J44") ' replace Range("J5:J44") with
                    ABill.Value = ABill.Value + ABill.Offset(0, -1).Value
                Next
            'Replaces previous completed % with up to Date completion, _
            writes directly to sheet 39 times, with a time penalty.
            mySht.Range("F5").Resize(Rng.Rows.Count, Rng.Columns.Count).Cells.Value = Rng.Cells.Value

        End Select

        '   Long range parenthetical With... End With procedure ends
        .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With
End Sub