Hello
For some reason when I run the following code half the screen flickers across until it finishes running. I've included "Application.ScreenUpdating = False/True" at the beginning and end. It's only started flickering like this since I changed the first part of the code where it creates a new pivot table. Is there an easy way to stop this flickering without starting again?
Sub submitwritten()
Application.ScreenUpdating = False
If Range("I60").Value = "Yes" Then
Sheets("ANALYSIS(2)").Visible = True
Sheets("ANALYSIS(2)").Select
Range("C7:F172").Select
Selection.ClearContents
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="=MASTERWRITTEN" _
).CreatePivotTable TableDestination:= _
"'ANALYSIS(2)'!R10C9", TableName _
:="PivotTable2", DefaultVersion:=xlPivotTableVersion10
With ActiveSheet.PivotTables("PivotTable2").PivotFields("MONTH")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("DEPARTMENT")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("ADVISOR")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
"PivotTable2").PivotFields("FORM NO."), "Count of FORM NO.", xlCount
ActiveWorkbook.ShowPivotTableFieldList = False
Range("I10").Select
ActiveSheet.PivotTables("PivotTable2").PivotFields("Month").ClearAllFilters
On Error GoTo err_handler
ActiveSheet.PivotTables("PivotTable2").PivotFields("MONTH").CurrentPage = Sheets("TEAM RECORDS TELEPHONY").Range("F8").Value
ActiveSheet.PivotTables("PivotTable2").PivotFields("DEPARTMENT").CurrentPage = Sheets("TEAM RECORDS TELEPHONY").Range("F10").Value
Range("H6:K167").Select
Selection.Copy
Range("C7").Select
ActiveSheet.Paste
Range("C6").Select
ActiveSheet.Paste
Columns("I:J").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("D9").Select
Sheets("MAINTAIN RECORDS").Visible = True
Sheets("MAINTAIN RECORDS").Select
Range(Sheets("MAINTAIN RECORDS").Range("C9").Value).Select
Selection.Copy
Range("E13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E13:G112").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
Sheets("TEAM RECORDS WRITTEN").Visible = True
Sheets("TEAM RECORDS WRITTEN").Select
ActiveSheet.Unprotect
Range("E16:H116").Select
Selection.Copy
Range("Z124").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("TEAM RECORDS WRITTEN").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("TEAM RECORDS WRITTEN").Sort.SortFields.Add Key:= _
Range("AB125:AB224"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("TEAM RECORDS WRITTEN").Sort.SortFields.Add Key:= _
Range("AC125:AC224"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("TEAM RECORDS WRITTEN").Sort
.SetRange Range("Z124:AC224")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Last = Cells(Rows.Count, "AC").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "AC").Value) = "N" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
Last = Cells(Rows.Count, "AB").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "AB").Value) = "Yes" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
Range("Z125:Z225").Select
ActiveWorkbook.Names.Add Name:="named", RefersToR1C1:= _
"='TEAM RECORDS WRITTEN'!R124C26:R225C26"
Range("F12").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=named"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Sheets("MAINTAIN RECORDS").Visible = False
Sheets("ANALYSIS(2)").Visible = False
Sheets("TEAM RECORDS WRITTEN").Select
Range("F12").Select
Range("f12").Value = "Adviser No."
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Else
MsgBox "Your password is incorrect. Please try again.", vbInformation, "OOPS!"
End If
Application.ScreenUpdating = True
Exit Sub
err_handler:
Sheets("ANALYSIS(2)").Select
ActiveSheet.PivotTables("PivotTable2").PivotFields("MONTH").CurrentPage = _
"(blank)"
ErrHandler:
N = 1
' go back to the line following the error
Resume Next
End Sub
For some reason when I run the following code half the screen flickers across until it finishes running. I've included "Application.ScreenUpdating = False/True" at the beginning and end. It's only started flickering like this since I changed the first part of the code where it creates a new pivot table. Is there an easy way to stop this flickering without starting again?
Sub submitwritten()
Application.ScreenUpdating = False
If Range("I60").Value = "Yes" Then
Sheets("ANALYSIS(2)").Visible = True
Sheets("ANALYSIS(2)").Select
Range("C7:F172").Select
Selection.ClearContents
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="=MASTERWRITTEN" _
).CreatePivotTable TableDestination:= _
"'ANALYSIS(2)'!R10C9", TableName _
:="PivotTable2", DefaultVersion:=xlPivotTableVersion10
With ActiveSheet.PivotTables("PivotTable2").PivotFields("MONTH")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("DEPARTMENT")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("ADVISOR")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
"PivotTable2").PivotFields("FORM NO."), "Count of FORM NO.", xlCount
ActiveWorkbook.ShowPivotTableFieldList = False
Range("I10").Select
ActiveSheet.PivotTables("PivotTable2").PivotFields("Month").ClearAllFilters
On Error GoTo err_handler
ActiveSheet.PivotTables("PivotTable2").PivotFields("MONTH").CurrentPage = Sheets("TEAM RECORDS TELEPHONY").Range("F8").Value
ActiveSheet.PivotTables("PivotTable2").PivotFields("DEPARTMENT").CurrentPage = Sheets("TEAM RECORDS TELEPHONY").Range("F10").Value
Range("H6:K167").Select
Selection.Copy
Range("C7").Select
ActiveSheet.Paste
Range("C6").Select
ActiveSheet.Paste
Columns("I:J").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("D9").Select
Sheets("MAINTAIN RECORDS").Visible = True
Sheets("MAINTAIN RECORDS").Select
Range(Sheets("MAINTAIN RECORDS").Range("C9").Value).Select
Selection.Copy
Range("E13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E13:G112").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
Sheets("TEAM RECORDS WRITTEN").Visible = True
Sheets("TEAM RECORDS WRITTEN").Select
ActiveSheet.Unprotect
Range("E16:H116").Select
Selection.Copy
Range("Z124").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("TEAM RECORDS WRITTEN").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("TEAM RECORDS WRITTEN").Sort.SortFields.Add Key:= _
Range("AB125:AB224"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("TEAM RECORDS WRITTEN").Sort.SortFields.Add Key:= _
Range("AC125:AC224"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("TEAM RECORDS WRITTEN").Sort
.SetRange Range("Z124:AC224")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Last = Cells(Rows.Count, "AC").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "AC").Value) = "N" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
Last = Cells(Rows.Count, "AB").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "AB").Value) = "Yes" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
Range("Z125:Z225").Select
ActiveWorkbook.Names.Add Name:="named", RefersToR1C1:= _
"='TEAM RECORDS WRITTEN'!R124C26:R225C26"
Range("F12").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=named"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Sheets("MAINTAIN RECORDS").Visible = False
Sheets("ANALYSIS(2)").Visible = False
Sheets("TEAM RECORDS WRITTEN").Select
Range("F12").Select
Range("f12").Value = "Adviser No."
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Else
MsgBox "Your password is incorrect. Please try again.", vbInformation, "OOPS!"
End If
Application.ScreenUpdating = True
Exit Sub
err_handler:
Sheets("ANALYSIS(2)").Select
ActiveSheet.PivotTables("PivotTable2").PivotFields("MONTH").CurrentPage = _
"(blank)"
ErrHandler:
N = 1
' go back to the line following the error
Resume Next
End Sub