Still flickering screen when running vba...

K

kit99

Active Member
Joined
Mar 17, 2015
Messages
352
In a previous thread I was adviced to get rid of .Activate, .Select, and .Selection - as these both slow down code and is known to cause flickering screen. And then to put Application.ScreenUpdating = False at the top of my code.
Through several other threads and a lot of help, I've changed several bits of my code, and is now ended up with the code below.

My vba is run from ThisWorkbook. It opens up wb.gr1 and updates this with several reports (several other wb's).
Code is working, and is a lot faster, and has got less flickering - but flickering is still present...
Flickering appears when code opens up other wb's, both Gr1 and reports. Flickering is a white screen visible maybe half a second for each wb that is opened/closed.

Is there anything else can I do now? Or do I have to live with it?
I've noticed that if I open up both ThisWorkbook and Gr1 before I start the vba there is no flickering. The flickering is only present when I start the vba from ThisWorkbook when Gr1 is closed down - as it is supposed to be. Is this a clue?

And there is another thing I'm wondering obout: I had to put in Application.Goto sh_dash.Range("A1"), True at the bottom of my vba, or else sheet sh_sc2 was unhidden at the end of the run. And I can't understand why. I don't unhide any sheets in this vba, and sheet sh_sc2 is unhidden when I start the vba...

Code: 
Option Explicit

Sub KIT_01_UpdateGroup1()

Application.StatusBar = "Now Updating: Gr1 (opening fil)"
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim fPath As String, FoundRow As Range
Dim wb_rapp As Workbook, wb_gr As Workbook
Dim sh_nysum As Worksheet, sh_nyfl1 As Worksheet, sh_nyfl2 As Worksheet, sh_nyfl3 As Worksheet, sh_nyfl4 As Worksheet
Dim sh_dash As Worksheet, sh_kont As Worksheet, sh_data As Worksheet, sh_sc1 As Worksheet, sh_sc2 As Worksheet
Dim sh_pivov As Worksheet, sh_pivin As Worksheet
Dim pt As PivotTable, pf As PivotFields, cell As Range

    fPath = ThisWorkbook.Path
    If Right(fPath, 1) = "\" Then
        fPath = Left(fPath, Len(fPath) - 1)
    End If

Set wb_gr = Workbooks.Open(ThisWorkbook.Path & "\Gr1_(M).xlsm")
    With wb_gr
        Set sh_dash = .Worksheets("Dashboard")
        Set sh_kont = .Worksheets("Kont")
        Set sh_nysum = .Worksheets("NYsum")
        Set sh_nyfl1 = .Worksheets("NYfl1")
        Set sh_nyfl2 = .Worksheets("NYfl2")
        Set sh_nyfl3 = .Worksheets("NYfl3")
        Set sh_nyfl4 = .Worksheets("NYfl4")
        Set sh_data = .Worksheets("Data1")
        Set sh_sc1 = .Worksheets("sc1")
        Set sh_sc2 = .Worksheets("sc2")
        Set sh_pivov = .Worksheets("piv-ov")
        Set sh_pivin = .Worksheets("piv-in")
    End With
    
Application.StatusBar = "Now Updating: Gr1 (new reports ov fl)"
    Set wb_rapp = Workbooks.Open(fPath & "\R2\" & "OV - FL rapport sum.xls")
    wb_rapp.Sheets(1).Cells.Copy sh_nysum.Range("A1")
    wb_rapp.Close False
    
    Set wb_rapp = Workbooks.Open(fPath & "\R2\" & "OV - FL rapport nr1.xls")
    wb_rapp.Sheets(1).Cells.Copy sh_nyfl1.Range("A1")
    wb_rapp.Close False
    
    Set wb_rapp = Workbooks.Open(fPath & "\R2\" & "OV - FL rapport nr2.xls")
    wb_rapp.Sheets(1).Cells.Copy sh_nyfl2.Range("A1")
    wb_rapp.Close False
    
    Set wb_rapp = Workbooks.Open(fPath & "\R2\" & "OV - FL rapport nr3.xls")
    wb_rapp.Sheets(1).Cells.Copy sh_nyfl3.Range("A1")
    wb_rapp.Close False
    
    Set wb_rapp = Workbooks.Open(fPath & "\R2\" & "OV - FL rapport nr4.xls")
    wb_rapp.Sheets(1).Cells.Copy sh_nyfl4.Range("A1")
    wb_rapp.Close False
      
Application.StatusBar = "Now Updating: Gr1 (storing results)"
    Set FoundRow = sh_kont.Columns(1).Find("SUM alle kont", lookat:=xlWhole, LookIn:=xlValues)
        FoundRow.Offset(, 6).Resize(1, 139).Copy
            sh_data.Range("C" & sh_data.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
        
Application.StatusBar = "Now Updating: Gr1 (new reports sc)"
    Set wb_rapp = Workbooks.Open(fPath & "\SC\" & "SC - Rapport nr 1.xls")
        wb_rapp.Sheets(1).Range("B4:B6").Copy
            sh_sc2.Range("C" & sh_sc2.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
        wb_rapp.Sheets(1).Range("C7:C7").Copy
            sh_sc2.Range("F" & sh_sc2.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
        wb_rapp.Close False
        
    Set wb_rapp = Workbooks.Open(fPath & "\SC\" & "SC - Rapport nr 2.xls")
        wb_rapp.Sheets(1).Range("B4:B6").Copy
            sh_sc2.Range("I" & sh_sc2.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
        wb_rapp.Sheets(1).Range("C7:C7").Copy
            sh_sc2.Range("L" & sh_sc2.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
        wb_rapp.Close False
        
    Set wb_rapp = Workbooks.Open(fPath & "\SC\" & "SC - Rapport nr 3.xls")
        wb_rapp.Sheets(1).Range("B4:B6").Copy
            sh_sc2.Range("O" & sh_sc2.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
        wb_rapp.Sheets(1).Range("C7:C7").Copy
            sh_sc2.Range("R" & sh_sc2.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
        wb_rapp.Close False
        
    Set wb_rapp = Workbooks.Open(fPath & "\SC\" & "SC - Rapport nr 4.xls")
        wb_rapp.Sheets(1).Range("B4:B6").Copy
            sh_sc2.Range("U" & sh_sc2.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
        wb_rapp.Sheets(1).Range("C7:C7").Copy
            sh_sc2.Range("X" & sh_sc2.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
        wb_rapp.Close False
        
    Set wb_rapp = Workbooks.Open(fPath & "\SC\" & "SC - Rapport nr 5.xls")
        wb_rapp.Sheets(1).Range("B4:B6").Copy
            sh_sc2.Range("AA" & sh_sc2.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
        wb_rapp.Sheets(1).Range("C7:C7").Copy
            sh_sc2.Range("AD" & sh_sc2.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
        wb_rapp.Close False
        
    Set wb_rapp = Workbooks.Open(fPath & "\SC\" & "SC - Rapport nr 6.xls")
        wb_rapp.Sheets(1).Range("B4:B6").Copy
            sh_sc2.Range("AG" & sh_sc2.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
        wb_rapp.Sheets(1).Range("C7:C7").Copy
            sh_sc2.Range("AJ" & sh_sc2.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
        wb_rapp.Close False
        
    Set wb_rapp = Workbooks.Open(fPath & "\SC\" & "SC - Rapport nr 7.xls")
        wb_rapp.Sheets(1).Range("B4:B6").Copy
            sh_sc2.Range("AM" & sh_sc2.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
        wb_rapp.Sheets(1).Range("C7:C7").Copy
            sh_sc2.Range("AP" & sh_sc2.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
        wb_rapp.Close False
               
Application.StatusBar = "Now Updating: Gr1 (values from sc2 to sc1)"
    sh_sc1.Range("U3:U198").Value = sh_sc2.Range("B3:B198").Value
    sh_sc1.Range("V3:V198").Value = sh_sc2.Range("H3:H198").Value
    sh_sc1.Range("W3:W198").Value = sh_sc2.Range("N3:N198").Value
    sh_sc1.Range("X3:X198").Value = sh_sc2.Range("T3:T198").Value
    sh_sc1.Range("Y3:Y198").Value = sh_sc2.Range("Z3:Z198").Value
    sh_sc1.Range("Z3:Z198").Value = sh_sc2.Range("AF3:AF198").Value
    sh_sc1.Range("AA3:AA198").Value = sh_sc2.Range("AL3:AL198").Value
        
            For Each cell In sh_sc1.Range("U3:AA198")
            If cell.Value = "0" Then cell.ClearContents
            Next cell
        
    sh_sc1.Range("AC3:AC198").Value = sh_sc2.Range("E3:E198").Value
    sh_sc1.Range("AD3:AD198").Value = sh_sc2.Range("K3:K198").Value
    sh_sc1.Range("AE3:AE198").Value = sh_sc2.Range("Q3:Q198").Value
    sh_sc1.Range("AF3:AF198").Value = sh_sc2.Range("W3:W198").Value
    sh_sc1.Range("AG3:AG198").Value = sh_sc2.Range("AC3:AC198").Value
    sh_sc1.Range("AH3:AH198").Value = sh_sc2.Range("AI3:AI198").Value
    sh_sc1.Range("AI3:AI198").Value = sh_sc2.Range("AO3:AO198").Value
        
            For Each cell In sh_sc1.Range("AC3:AI198")
            If cell.Value = "0" Then cell.ClearContents
            Next cell
        
    sh_sc1.Range("AS3:AY198").Value = sh_sc1.Range("AK3:AQ198").Value

            For Each cell In sh_sc1.Range("AS3:AY198")
            If cell.Value = "0" Then
            cell.Value = cell.Offset(-1, 0).Value
            End If
            Next cell
           
Application.StatusBar = "Now Updating: Gr1 (updating pivot-tables)"
    For Each pt In sh_pivov.PivotTables
        pt.RefreshTable
    Next pt

    sh_pivov.PivotTables("Pivottabell7").PivotFields("Kontrollområde").AutoSort xlAscending, "Ferdig2"
    sh_pivov.PivotTables("Pivottabell8").PivotFields("Kontrollområde").AutoSort xlAscending, "Under arbeid2"
    sh_pivov.PivotTables("Pivottabell1").PivotFields("Kontrollområde").AutoSort xlAscending, "Ferdig6"

    For Each pt In sh_pivov.PivotTables
        pt.RefreshTable
    Next pt

    For Each pt In sh_pivin.PivotTables
        pt.RefreshTable
    Next pt
   
Application.StatusBar = "Now Updating: Gr1 (store and close file)"
Application.Goto sh_dash.Range("A1"), True
wb_gr.Save
wb_gr.Close False
    
Application.StatusBar = False
End Sub
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
You must log in or register to reply here.

Similar threads

willow1985
  • Solved
VBA Run-time error 91 - Object variable or With block variable not set when trying to refresh data/Sleep
Replies
4
Views
400
willow1985
willow1985
D
  • Solved
Insert formula in last column macro
2
Replies
13
Views
215
MARK858
MARK858
F
  • Solved
How to make loop stop when the cell is empty? (VBA)
Replies
3
Views
298
kvsrinivasamurthy
K
brent3162
  • Solved
VBA help with increasing row before macro runs again.
Replies
3
Views
378
jolivanes
jolivanes
C
  • Question Question
VBA to save file to SharePoint and attach to outlook template saved in SharePoint
Replies
6
Views
283
Chris8630
C

Forum statistics

Threads
1,224,823
Messages
6,181,182
Members
453,021
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top