View Full Version : Solved: Avoid Screen flickering and selection

05-23-2012, 08:22 PM

Is there a way to avoid screen flickering when copying from a workbook to another.

I have a code and it does the work its supposed to but the screen issue is the problem here.

here is my code

Sub AddSystems(varColumns As String)


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Call ClearContents

Workbooks.Open Filename:="C:\Quick\Reference Workbook.xlsx"
Range(varColumns & 2, Range(varColumns & Rows.Count).End(xlUp)).Copy

Windows("Quick BOM.v1.3.xlsm").Activate
ActiveWorkbook.Sheets("Appendix Data").Activate
Range("A4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Windows("Reference Workbook.xlsx").Activate


Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

and my code under my form that triggers this code

Private Sub CommandButton1_Click()

If Systemsbttn1 = True Then
Call AddSystems("A")
End If


End Sub

05-23-2012, 11:43 PM
Greetings Fred,

I think the issue is the activating of other sheets/workbooks probably forces a repaint.

Quickly tested, but see if this helps:

In the Userform:
Option Explicit

Private Sub CommandButton1_Click()
Dim strMsgText As String

If Not AddSystems(1, strMsgText) Then
Application.ScreenUpdating = True

MsgBox "Error: " & strMsgText
End If
End Sub

In a Standard Module:
Option Explicit

Function AddSystems(ByVal ColumnNumber As Long, ByRef MsgTxt As String) As Boolean
Dim WB As Workbook
Dim wksSource As Worksheet
Dim wksDest As Worksheet
Dim lLRow As Long

Application.ScreenUpdating = False
'Application.DisplayAlerts = False '<---We may not want this
'Call ClearContents '<--- not shown, so unknown if a repaint will be forced.

'// In case something is awry, we could test each step. //
On Error GoTo ErrHandler
'// Attempt to set a reference to the Object, in this case, the opening workbook. //
'// we fail, we can handle by using the False returned by the function we are in. //
MsgTxt = "Workbook not found"
Set WB = Workbooks.Open(ThisWorkbook.Path & "\Reference Workbook.xlsx", ReadOnly:=True)
MsgTxt = "The worksheet: ""Systems"" does not exist in " & WB.Name
Set wksSource = WB.Worksheets("Systems")
'// I am assuming that "Quick BOM.v1.3.xlsm" is ThisWorkbook, change to suit. //
MsgTxt = "The worksheet ""Appendix Data"" does not exist in " & ThisWorkbook.Name
Set wksDest = ThisWorkbook.Worksheets("Appendix Data")
On Error GoTo 0

With wksSource
'// Check that running up from the bottom of the sheet doesn't end us up in the //
'// header row. //
lLRow = .Cells(.Rows.Count, ColumnNumber).End(xlUp).Row
If lLRow < 2 Then
MsgTxt = "No data to copy"
'Exit Function
GoTo ErrHandler
End If

'// Just take the value of the source range to the destination range w/o //
'// copy/paste. //
wksDest.Range("A4").Resize(lLRow - 1).Value _
= .Range(.Cells(2, ColumnNumber), .Cells(lLRow, ColumnNumber)).Value
End With

WB.Close False
AddSystems = True
Application.ScreenUpdating = True
Exit Function
If Not WB Is Nothing Then WB.Close False
Application.ScreenUpdating = True
End Function


05-24-2012, 06:07 AM
Thanks for the help,

But everytime I try to run it it gives me the error : Workbook not found

05-24-2012, 12:21 PM
Thanks for the help,

But everytime I try to run it it gives me the error : Workbook not found
Did you change the path to suit?
Set WB = Workbooks.Open(ThisWorkbook.Path & "\Reference Workbook.xlsx", ReadOnly:=True)

05-24-2012, 01:23 PM
Yes, I still cannot get it.

Dont worry at the end I put the data in the same workbook in a hidden sheet. It does not use up as much space as I thought. And my prblem of screen flickering reduced.

thank you very much for the help GTO

05-24-2012, 09:19 PM

I found another way to do it. well after i copied the sheet into the workbook (no huge file size sacrifice) I used the following piece of code to copy from one to the other.

Sheets("Appendix Data").Range("A6:A406").Value = Sheets("Systems").Range(varColumns & 2, varColumns & 402).Value

here is the link to the post where I found the solution Link (http://www.ozgrid.com/VBA/SpeedingUpVBACode.htm)