The screen gets crazy and doesn't refresh properly and the calculation method turns manual

[gerotutu]

Hi all

I am in a big (at least for me) project for a NGO upgrading a tool to forecast. To make everything simpler I basically collate data from 600 tables in different sheets as I explained in this post http://www.mrexcel.com/forum/excel-...-collate-600-tables-into-1-a.html#post4231649. Everything goes to 'tChannelsCollation' which is a master table from where I want to build pivot tables.

After I solved the performance issue everything was going fine until I don't know what happened or what I did but the screen started to flicker and not refresh. It was like the sheets were temporally overlapped and everything looked a mess. At the beginning after scrolling up or down was fine but got worst.

I tried several things looking in the internet and I realised that the calculation method were turning manual all the time after I execute the following Macro (which is the main one)

Sub Extractor()
'
' byYearExtractor Macro
'
    Dim i As Integer
    Dim n As Integer
    Dim Range2 As Range, Range1 As Range
    Dim Source As String, Destiny As String, TableName As String, AdditionalColumn As String
    Dim UniqueDestinyArray As Variant, FullDestinyArray As Variant
    Dim flagsSource As Boolean, flagDestiny As Boolean, flagLoadTable As Boolean
 
    Dim ws As Worksheet
 
    On Error GoTo errHandler
    Application.ScreenUpdating = False
 
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
 
    Call UNPROTECT_SHEETS
 
 
    Set ws = ActiveSheet
 
    If Sheets("LoadTable").Visible = False Then flagLoadTable = True
    If Sheets("LoadTable").Visible = False Then Sheets("LoadTable").Visible = True
 
    Sheets("LoadTable").Select
 
    'Clear columns F (No. of columns)and D (Table name)
    Range("F2:F999").ClearContents
    Range("D2:D999").ClearContents
 
    Range("A1").Select
 
    NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count - 1
 
    If NumRows = 0 Or NumRows > 1000 Then
    MsgBox ("insert a table to load or less than 500 tables")
    Exit Sub
    End If
     
 
    'Clear tables in Destiny Sheets
    FullDestinyArray = Range("E2", Range("E2").End(xlDown))
    UniqueDestinyArray = UniqueItems(FullDestinyArray, False)
 
    For i = LBound(UniqueDestinyArray) + 1 To UBound(UniqueDestinyArray)
    Destiny = UniqueDestinyArray(i)
 
    If Sheets(Destiny).Visible = False Then flagDestiny = True
    If Sheets(Destiny).Visible = False Then Sheets(Destiny).Visible = True

    Sheets(Destiny).Select
    Range("A2:ZZ65563").ClearContents
    Range("A2").Select
 
    Next
 
    'Load tables
    Sheets("LoadTable").Select
    Range("A2").Select
    For i = 0 To NumRows - 1
        Do While ActiveCell(i + 1, 8).Value = "NO"
        i = i + 1
        Loop
     
        If ActiveCell(i + 1, 8).Value = "YES" Then
     
        'if the line lacks of data, exit
        Set Range1 = ActiveCell(i + 1, 2)
        If Range1 = "" Then
            MsgBox "Complete initial cell"
            Exit Sub
        End If
     
        Set Range2 = ActiveCell(i + 1, 3)
        If Range2 = "" Then
            MsgBox "Complete ending cell"
            Exit Sub
        End If
     
        Source = ActiveCell(i + 1, 1)
        If Source = "" Then
            MsgBox "Complete sources"
            Exit Sub
        End If
     
        Destiny = ActiveCell(i + 1, 5)
        If Destiny = "" Then
            MsgBox "Complete destinations"
            Exit Sub
        End If
     
        'No of columns
        ActiveCell(i + 1, 4).Value = Range(Range1 & ":" & Range2).Columns.Count
        numberColumns = Range(Range1 & ":" & Range2).Columns.Count
     
        'No of rows
        numberRows = Range(Range1 & ":" & Range2).Rows.Count
             
        'Optional column
        AdditionalColumn = ActiveCell(i + 1, 7)
     
        If Sheets(Source).Visible = False Then flagSource = True
        If Sheets(Source).Visible = False Then Sheets(Source).Visible = True
             
        'Get table name
        TableName = Sheets(Source).Range(Range1).Offset(-1, 0)
        Sheets(Source).Range(Range1).Offset(-1, 0).Copy
        ActiveCell(i + 1, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     
         
        'Get data table
        Sheets(Source).Range(Range1 & ":" & Range2).Copy
     
        If Sheets(Destiny).Visible = False Then flagDestiny = True
        If Sheets(Destiny).Visible = False Then Sheets(Destiny).Visible = True
     
        Sheets(Destiny).Select
        Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
     
        Range("A65536").End(xlUp).Activate
         
            For n = 0 To Range(Range1 & ":" & Range2).Rows.Count - 1
            ActiveCell.Offset(n + 1, 0).Value = TableName
            Next
     
        If AdditionalColumn <> "" Then
            Range("A1").End(xlDown).Offset(-numberRows, numberColumns + 1).Select
            For Z = 0 To Range(Range1 & ":" & Range2).Rows.Count - 1
            ActiveCell.Offset(Z + 1, 0).Value = AdditionalColumn
            Next
        End If
     
        AdditionalColumn = ""
     
        Range("A1").Select
     
        If flagSource = True Then Sheets(Source).Visible = False
        If flagSource = True Then flagSource = False
     
        If flagDestiny = True Then Sheets(Destiny).Visible = False
        If flagDestiny = True Then flagDestiny = False
     
        Sheets("LoadTable").Select
        Range("A2").Select
 
    End If
 
    Next
 
    If flagLoadTable = True Then Sheets("LoadTable").Visible = False
    If flagLoadTable = True Then flagLoadTable = False
 
    ws.Activate
    Sheets("LoadTable").Select


    ActiveWorkbook.RefreshAll
 
    Call SHOW_PIVOTTABLE
    Call RefreshAll
 
 
 
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
 
    Application.ScreenUpdating = True
errHandler:
    Application.ScreenUpdating = True

    Sheets("ChannelsCollation").Visible = False
    Sheets("YrXMtTables").Visible = False
    Sheets("MonthTables").Visible = False
 
    Call PROTECT_SHEETS
 
    Sheets("HOMEPAGE").Select
 
End Sub

I completely lost the compass. I hope you can help me out with this. Just in case you need to see the workbook you can download it here. I didn't attach it because it's around 12 MB (I don't know neither how it got from one moment to other so big)

https://www.wetransfer.com/download...3fb82b45a8647cd22ff95fd720150803003347/2c5198

Beside all this I have had another issue (I think it's not connected to the previous ones). Every time I save as... with a new name all references in the pivot tables keep static to the previous file. I read in some forums that this was a bug in Excel 2013. Is it right? How do I solve this out?

Summarising:
- Screen gets crazy refreshing and sheets and are seen overlapped after I manually change the calc mode to automatic
- Calculation method is changed to manual after execution of macro Extractor
- Pivot tables keep static the source with references to previous files when saving with a new name

Many many thanks.
All the best,
Gerónimo

 

[Kev20]

I'd suggest you repeat your line

 Application.Calculation = xlCalculationAutomatic

before each of your

Exit Sub

lines

 

[Debaser]

Also your error handler section should reset calculation, events and the status bar.