2
votes

I know there are lots of threads relating to this topic, like don't use "Select" or "Activate" or set it to false if you need to use it. I set it to False every time I use "select" or "activate", but it still not working, please help!!

Sub Forecast()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.DisplayStatusBar = True
    'Application.StatusBar = "Please be patient..."

    Dim Rating As Variant, sht As Worksheet, LastRecordRow As Long, i As Integer, LastRow As Long

    Rating = InputBox("Please Provide Weather Rating (Any Number Between 1 and 4)", "Input Needed")

    If Rating < 0 Or Rating > 4 Then
        MsgBox "Invalid Value, Please Enter A Valid Number! (1~4)", , "Alert!!!"
        Exit Sub
    Else

        For Each sht In ActiveWorkbook.Worksheets
        If sht.Name = "Forecast" Then
            sht.Range("a1") = ""
        Else
            LastRecordRow = sht.Range("A1").End(xlDown).Row
            sht.Range("I1:O1").EntireColumn.Delete
            Application.Run "ATPVBAEN.XLAM!Regress", sht.Range("$B$1", "$B" & LastRecordRow), _
            sht.Range("$C$1", "$C" & LastRecordRow), False, True, , sht.Range("$I$1") _
            , False, False, False, False, , False
            PVTotal = Application.WorksheetFunction.Sum(Range("B2", "B" & LastRecordRow))
            ImpTotal = Application.WorksheetFunction.Sum(Range("D2", "D" & LastRecordRow))
            sht.Range("B" & LastRecordRow + 1) = PVTotal
            sht.Range("D" & LastRecordRow + 1) = ImpTotal
            sht.Cells.EntireColumn.AutoFit
            sht.Range("A1").Select
        End If
        Next sht

        Worksheets("Forecast").Activate

        i = 1

        ActiveSheet.Range("B" & i + 2, Range("H" & i + 2).End(xlDown)).EntireRow.Delete

        Do While i <= ActiveWorkbook.Worksheets.Count
            RowForSum = Worksheets(i).Range("B1").End(xlDown).Row
            With ActiveSheet
                .Cells(i + 2, 2).Value = Worksheets(i).Name
                .Cells(i + 2, 3).Value = Worksheets(i).Range("J17")
                .Cells(i + 2, 4).Value = Worksheets(i).Range("J18")
                .Cells(i + 2, 5).Value = Rating
                .Cells(i + 2, 6).Value = ActiveSheet.Cells(i + 2, 3).Value + ActiveSheet.Cells(i + 2, 4) * Rating
                If Worksheets(i).Range("B183").Value = 0 Then
                    .Cells(i + 2, 7).Value = 0
                Else
                    .Cells(i + 2, 7).Value = Worksheets(i).Range("D" & RowForSum).Value / Worksheets(i).Range("B" & RowForSum).Value
                End If
                    .Cells(i + 2, 8).Value = ActiveSheet.Cells(i + 2, 6).Value * ActiveSheet.Cells(i + 2, 7)
            End With
            i = i + 1
        Loop

        LastRow = ActiveSheet.Range("B2").End(xlDown).Row

        a = Application.WorksheetFunction.Sum(ActiveSheet.Range("F3", "F" & LastRow))
        b = Application.WorksheetFunction.Sum(ActiveSheet.Range("H3", "H" & LastRow))

        With ActiveSheet
            .Range("F" & LastRow + 1).Value = a
            .Range("F" & LastRow + 1).Offset(0, -4).Value = "Total"
            .Range("H" & LastRow + 1).Value = b
            .Range("A1").Select
            .Cells.EntireColumn.AutoFit
        End With

        Dim rng2 As Range
        For Each rng2 In ActiveSheet.Range("B2", Range("B2").End(xlDown))
            If rng2 = "Forecast" Then
                rng2.EntireRow.Delete
            Else
                If rng2 = "Total" Then rng2.EntireRow.Font.Bold = True
            End If
        Next
    End If

    Application.ScreenUpdating = True
    'Application.StatusBar = False
    Application.DisplayAlerts = True

End Sub
2
How is it not working, what's the error or the wrong behaviour you're seeing?djikay
the screen still is flickering until it gave me the resultswalkens
It's possible your setting is overridden by calling into some method, maybe the Regress in the Analysis ToolPak. Try putting the following statement: Debug.Print Application.ScreenUpdating throughout your code and, after your routine has finished, check to see if at any point it changes value. Also, screen updating won't work if you're debugging/stepping through the code. Not sure what else to suggest.djikay
djikay, thank you a lot for this, now I'm able to identify where is the bad guy messing up my setting, and you're right, it is the regress that make the setting back to TRUE. My next question is, even now I put App.ScreenUpdating = False before and after the regress statement, all screens are still flickering, any suggestions on that? Thank you a lot!walkens
Try to add more Debug.Print Application.ScreenUpdating throughout the rest of your code. Does the value change to True anywhere? There may be something else messing up the setting. Also, I read somewhere that having any watches active might cause a problem, so try removing any watches you may have and see if that makes any difference. I'm really struggling to find anything else to suggest.djikay

2 Answers

3
votes

I had a similar issue. Workbook which used Application.ScreenUpdating = False became slow in Excel 2016 and flickered while running VBA that updated worksheets.

Using message boxes and Debug.Print statements I tracked it down to a loop that updated cell contents using code like:

Dim rowCounter As Integer
For rowCounter = 1 To numberOfEmployees
    'Do some work
    If (someCondition) Then
        startCell.offset(rowCounter).Value = ""
    Else 
        startCell.offset(rowCounter).Value = "something else"
    End If
Next rowCounter

If I replaced the following line

startCell.offset(rowCounter).Value = ""

with either of

startCell.offset(rowCounter).Value = "anything except empty"

or

startCell.offset(rowCounter).ClearContents

then the flickering stopped and the time to execute the loop went from a few seconds to much less than 1s.

I am not sure why this worked.

So if any of your cells in the loop return empty string, you could try using either of these lines.

0
votes

Do not put in the same procedure / module / function it disabling and enabling. Leave Application.ScreenUpdating = False as needed and place Application.ScreenUpdating = true outside this procedure / module / function. For me it is the only way that really works.