Flickering Screen while running VBA

[jxj_00]

Hi,

My screen flickers while running the code. I have added the ScreenUpdating into my code however it still flickers.

I have attached my code below

Sub Specific_Column()
'Indirect Copy & Paste
'Copy from SOC Filter List 1 to Packing List
Application.ScreenUpdating = False
Dim lastrow As Long, erow As Long
Dim i As Integer
On Error Resume Next
Workbooks("SOC Filter List 1.xlsm").Worksheets("Filter List").Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'find last filled row'
lastrow = Workbooks("SOC Filter List 1.xlsm").Worksheets("Filter List").Cells(Rows.Count, 1).End(xlUp).Row

erow = Workbooks("Packing List.xlsm").Worksheets("Packing List").Cells(Rows.Count, "A").End(xlUp).Row + 1

For i = 4 To lastrow

    'SCN No.
    Workbooks("SOC Filter List 1.xlsm").Worksheets("Filter List").Cells(i, 2).Copy
    Workbooks("Packing List.xlsm").Worksheets("Packing List").Cells(erow, 1).PasteSpecial Paste:=xlPasteValues
    'Name
    Workbooks("SOC Filter List 1.xlsm").Worksheets("Filter List").Cells(i, 3).Copy
    Workbooks("Packing List.xlsm").Worksheets("Packing List").Cells(erow, 2).PasteSpecial Paste:=xlPasteValues
    'Delivery date
    Workbooks("SOC Filter List 1.xlsm").Worksheets("Filter List").Cells(i, 6).Copy
    Workbooks("Packing List.xlsm").Worksheets("Packing List").Cells(erow, 3).PasteSpecial Paste:=xlPasteValues
    'Order No.
    Workbooks("SOC Filter List 1.xlsm").Worksheets("Filter List").Cells(i, 11).Copy
    Workbooks("Packing List.xlsm").Worksheets("Packing List").Cells(erow, 4).PasteSpecial Paste:=xlPasteValues
    
    erow = erow + 1
Next i
Application.ScreenUpdating = True
End Sub

 

[Fluff]

How about

Sub jxj2()
   Dim lastrow As Long
   Dim Ary As Variant

   With Workbooks("SOC Filter List 1.xlsm").Worksheets("Filter List")
      On Error Resume Next
      .Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
      On Error GoTo 0
      lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
      Ary = Application.Index(.Range("A4:K" & lastrow).Value, Evaluate("row(1:" & lastrow - 3 & ")"), Array(2, 3, 6, 11))
   End With
   With Workbooks("Packing List.xlsm").Worksheets("Packing List")
      .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(Ary), 4).Value = Ary
   End With
End Sub

 

[jxj_00]

How about

Sub jxj2()
   Dim lastrow As Long
   Dim Ary As Variant

   With Workbooks("SOC Filter List 1.xlsm").Worksheets("Filter List")
      On Error Resume Next
      .Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
      On Error GoTo 0
      lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
      Ary = Application.Index(.Range("A4:K" & lastrow).Value, Evaluate("row(1:" & lastrow - 3 & ")"), Array(2, 3, 6, 11))
   End With
   With Workbooks("Packing List.xlsm").Worksheets("Packing List")
      .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(Ary), 4).Value = Ary
   End With
End Sub

Hi, the code worked and the screen no longer flickers. Thank you!

 

[Fluff]

You're welcome & thanks for the feedback.