Solved: Avoid Screen flickering and selection

[fredlo2010]

Hello,

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)

'ROUTINE TO ADD THE SYSTEMS TO THE MAIN TABLE

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

Workbooks.Open Filename:="C:\Quick\Reference Workbook.xlsx"
Sheets("Systems").Activate
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
ActiveWorkbook.Close

Range("A1").Select

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

Systems.Hide

End Sub

[GTO]

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
Me.Hide
DoEvents

MsgBox "Error: " & strMsgText
Me.Show
Else
Me.Hide
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
ErrHandler:
If Not WB Is Nothing Then WB.Close False
Application.ScreenUpdating = True
End Function

Mark

[fredlo2010]

Thanks for the help,

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

[GTO]

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)

[fredlo2010]

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

[fredlo2010]

Hi,

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)