VBA Refresh - half the screen flickers!

BOLTY

New Member
Joined
May 5, 2011
Messages
1
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
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

Forum statistics

Threads
1,224,564
Messages
6,179,543
Members
452,924
Latest member
JackiG

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top