Hello,
I need help with elimination of flickering in the sub below, application.Screenupadting does not work as it seems to be reseted each time the sub CopyManyRanges is called. Purpose of the code is to copy certain values from one workbook to another based on certain condition(always copying to the last row). Once the values are copied, blank rows need to be deleted as they are added if certain YC is not copied as it is already existing in planning.(If I dont write for each YC lDestLastRow+x, then all values are just overwriting themselves and instead of 4 rows I get only 1row with last values.... I'm new to VBA and don't know if this can be handled on a different way... )
After the blank rows are removed a filter and sorting is applied.
In case the cod is run when the Planning is closed and all 4YC need to be copied as none is existing in the planning then there is no flickering. If for example 2YC are already existing and 2 still need to be added then the flickering appears. Flickering also appears if Planning is opened. Each YC has a unique number based on which it is determined if it is already existing in the planning.
Thank you
[/CODE]
I need help with elimination of flickering in the sub below, application.Screenupadting does not work as it seems to be reseted each time the sub CopyManyRanges is called. Purpose of the code is to copy certain values from one workbook to another based on certain condition(always copying to the last row). Once the values are copied, blank rows need to be deleted as they are added if certain YC is not copied as it is already existing in planning.(If I dont write for each YC lDestLastRow+x, then all values are just overwriting themselves and instead of 4 rows I get only 1row with last values.... I'm new to VBA and don't know if this can be handled on a different way... )
After the blank rows are removed a filter and sorting is applied.
In case the cod is run when the Planning is closed and all 4YC need to be copied as none is existing in the planning then there is no flickering. If for example 2YC are already existing and 2 still need to be added then the flickering appears. Flickering also appears if Planning is opened. Each YC has a unique number based on which it is determined if it is already existing in the planning.
Thank you
VBA Code:
Sub Send_to_Planning()
'Find the last used row in both sheets and copy and paste data below existing data.
Application.ScreenUpdating = False
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim YCPath, YCNew, Planning As String
YCPath = ThisWorkbook.FullName
YCNww = ThisWorkbook.Name
Planning = "C:\Users\Desktop\YC_Planning"
'Set variables for copy and destination sheets
Set wsDest = Workbooks.Open(Planning).Worksheets("Plan")
Set wsCopy = Workbooks(YCNew).Worksheets("New 3")
Workbooks(YCNew).Worksheets("New 3").Activate
Application.ScreenUpdating = False
'2. Find first blank row in the destination range based on data in column A
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
' 3. Copy & Paste Data + Check if YC exists
'YC1
If Range("E8") <> "" And Range("AP56").Value = 1 Then
MsgBox "1 YC_ID already exists in planning)"
Application.ScreenUpdating = False
ElseIf Range("E8").Value <> 0 And Range("AP56").Value = 0 Then
wsCopy.Range("C11").Copy
wsDest.Range("A" & lDestLastRow).PasteSpecial Paste:=xlPasteValues
Call CopyManyRanges("C11", "A" & lDestLastRow, wsCopy, wsDest) 'unique number
Call CopyManyRanges("D23", "B" & lDestLastRow, wsCopy, wsDest)
Call CopyManyRanges("G22", "C" & lDestLastRow, wsCopy, wsDest)
Call CopyManyRanges("F7", "D" & lDestLastRow, wsCopy, wsDest)
End If
'YC2
If Range("O8") <> "" And Range("AQ56").Value = 1 Then
MsgBox "2 YC_ID already exists in planning)"
ElseIf Range("O8") <> "" And Range("AQ56").Value = 0 Then
Call CopyManyRanges("M11", "A" & lDestLastRow + 1, wsCopy, wsDest) 'unique number
Call CopyManyRanges("N23", "B" & lDestLastRow + 1, wsCopy, wsDest)
Call CopyManyRanges("Q22", "C" & lDestLastRow + 1, wsCopy, wsDest)
Call CopyManyRanges("P7", "D" & lDestLastRow + 1, wsCopy, wsDest)
End If
'YC3
If Range("Y8") <> "" And Range("AR56").Value = 1 Then
MsgBox "3 YC_ID already exists in planning)"
ElseIf Range("Y8") <> "" And Range("AR56").Value = 0 Then
Call CopyManyRanges("W11", "A" & lDestLastRow + 2, wsCopy, wsDest) 'unique number
Call CopyManyRanges("X23", "B" & lDestLastRow + 2, wsCopy, wsDest) '
Call CopyManyRanges("AA22", "C" & lDestLastRow + 2, wsCopy, wsDest)
Call CopyManyRanges("Z7", "D" & lDestLastRow + 2, wsCopy, wsDest)
End If
'YC4
If Range("AI8") <> "" And Range("AS56").Value = 1 Then
MsgBox "4 YC_ID already exists in planning)"
ElseIf Range("AI8") <> "" And Range("AS56").Value = 0 Then
Call CopyManyRanges("AG11", "A" & lDestLastRow + 3, wsCopy, wsDest) 'unique number
Call CopyManyRanges("AH23", "B" & lDestLastRow + 3, wsCopy, wsDest)
Call CopyManyRanges("AK22", "C" & lDestLastRow + 3, wsCopy, wsDest)
Call CopyManyRanges("AJ7", "D" & lDestLastRow + 3, wsCopy, wsDest)
End If
'to delete blank rows in Planning
Workbooks("YC_Planning.xlsm").Activate
Sheets("BREAKERS").Select
Range("a2:A15000").Select
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
If Worksheets("BREAKERS").AutoFilterMode = False Then
Worksheets("BREAKERS").Rows(1).Select
Worksheets("BREAKERS").Range("A1:E1").AutoFilter Field:=5, Criteria1:=""
ElseIf Worksheets("BREAKERS").AutoFilterMode = True Then
Worksheets("BREAKERS").Rows(1).Select
Worksheets("BREAKERS").Range("A1:E1").AutoFilter Field:=5, Criteria1:=""
End If
Range("A2:D150000", Range("A2:D150000").End(xlDown)).Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlYes
Application.ScreenUpdating = True
Workbooks("YC_Planning.xlsm").Save
End Sub
[CODE=vba]
Sub CopyManyRanges(Range_Orig As String, Range_Dest As String, wsCopy As Worksheet, wsDest As Worksheet)
wsCopy.Range(Range_Orig).Copy
wsDest.Range(Range_Dest).PasteSpecial Paste:=xlPasteValues
End Sub[/CODE]
