• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Disable showing sheet change while executing VBA code

Manish Sharma

Manish Sharma

Member
Hi Friends.

This is my first post. I have used the below line of code in all module, but even thought when i am executing the code it is showing the back end calculations, and stuck in other sheets where the calculations are happening. In short below line of code is not performing its work what it is supposed to do.

Application.screenupdating=false
Code: 
Application.screenupdating=true

Here is the full code which is giving me the problem. I have placed this code in general module.

[CODE=vb] 
Option Explicit

Sub Portfolio_All_Country()
'This will prepare the main result sheet to dump data
Application.ScreenUpdating = False

'To clear the range B15:BH4000
Sheets("PortTool").Select
Application.EnableEvents = False
With ActiveSheet.Range("B15:U21000")
.ClearFormats
.ClearContents
End With
Application.EnableEvents = True
Application.ScreenUpdating = True

Call Portfolio_Seleted_Criteria_All_Country
End Sub

Sub Portfolio_Seleted_Criteria_All_Country()
Application.ScreenUpdating = False
Dim n&, i&, ar As Variant, j&
ActiveWorkbook.Sheets("Portfolio AllCtry").Select
With Sheets("Portfolio AllCtry")

If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
Range("A60000:BL100500").Rows.ClearContents
End With

With Sheets("Portfolio AllCtry")
ar = .Range("E10:BH" & .Range("E" & .Rows.Count).End(xlUp).row).Value
End With

'This is to filter Country
ReDim result(1 To UBound(ar), 1 To UBound(ar, 2))

For i = 1 To UBound(ar, 1)
n = 0
For j = 35 To UBound(ar, 2)
If ar(i, j) <> "No" Then
n = n + 1
result(i, j) = ar(i, j)
result(i, 1) = ar(i, 1)
End If
Next j
Next i

With Sheets("Portfolio AllCtry")
.Range("A60000").Resize(i - 1, UBound(ar, 2)) = result
End With
Range("F10").Select 'This is to pull Corporation name
Range(Selection, Selection.End(xlDown)).Copy
Range("B60000").PasteSpecial


Range("A60000:B60000").Select
Range(Selection, Selection.End(xlDown)).Copy
Range("AG60000").PasteSpecial

'This is filter data as per given sales criteria
If Sheets("PortTool").Range("XER2").Value = "Less than" Then
ActiveSheet.Range("AG60000:BA100500").AutoFilter Field:=2, Criteria1:="<" & Sheets("PortTool").Range("XEV3"), Operator:=xlAnd
ElseIf Sheets("PortTool").Range("XER2").Value = "Greater than" Then
ActiveSheet.Range("AG60000:BA100500").AutoFilter Field:=2, Criteria1:=">" & Sheets("PortTool").Range("XEV3"), Operator:=xlAnd
Else
ActiveSheet.Range("AG60000:BA100500").AutoFilter Field:=2, Criteria1:=">=" & Sheets("PortTool").Range("XEV3"), Operator:=xlAnd, Criteria2:="<=" & Sheets("PortTool").Range("XEW3")
End If
Range("AH60000").Select


Application.ScreenUpdating = True

Call MoveOneCellDownAFilteredListAllCntrl
End Sub
Sub MoveOneCellDownAFilteredListAllCntrl()
Application.ScreenUpdating = False
Range("AH60000").Select
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop

Application.ScreenUpdating = True

Call IfNoDataPortfolioAllCntrl
End Sub

Sub IfNoDataPortfolioAllCntrl()
Application.ScreenUpdating = False

If Selection.Value = "" Then
Sheets("PortTool").Select
MsgBox ("No data available for selected criteria"), vbOKOnly
Exit Sub
Else
Range("C17").Select
End If
Application.ScreenUpdating = True

Call CopyFilterRangeAllCountryPortfolio
End Sub

Sub CopyFilterRangeAllCountryPortfolio()
Application.ScreenUpdating = False
Sheets("Portfolio AllCtry").AutoFilter.Range.Copy
Sheets("PortTool").Activate
With Sheets("PortTool")

Range("C16").PasteSpecial
Range("C17").Select
End With

Application.ScreenUpdating = True

Call PortCreateMainTablewithPercntAllCountry
End Sub

Sub PortCreateMainTablewithPercntAllCountry()
Application.ScreenUpdating = False
Range("C16:D16").Select
Range(Selection, Selection.End(xlDown)).Copy
Range("AP16").PasteSpecial
Range("AP16").Select
Application.ScreenUpdating = True

Call SelectRangeFillDownAllCountry
End Sub

Sub SelectRangeFillDownAllCountry()
Application.ScreenUpdating = False

Range("AP16").Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Offset(0, 1).Select
Range(Selection, Selection.Offset(0, 15)).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown

Range("AR17:BG17").Select

Range(Selection, Selection.End(xlDown)).Copy
Range("E17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.ScreenUpdating = True

Call AllCountryPortfolioFormatRange
End Sub


Sub AllCountryPortfolioFormatRange()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim MyBaseRng As Range
Dim MyRng As Range
Dim iRowOffset As Integer
Dim iColOffset As Integer
Dim iRowSize As Integer
Dim iColSize As Integer

'This is to name headers of columns
Range("C16").Value = "Corporation"
Range("D16").Value = "Total Sales"
Range("X16:AM16").Copy
Range("E16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("E15:T15").Select
Selection.MergeCells = True
Range("E15").Value = "Share in ATC class (%)"

'This is to set main data range
Set MyBaseRng = Range("E17").CurrentRegion
With MyBaseRng
iRowOffset = 2
iColOffset = 0
iRowSize = .Rows.Count - 2
iColSize = .Columns.Count
End With
Set MyRng = MyBaseRng _
.Offset(RowOffset:=iRowOffset, columnOffset:=iColOffset) _
.Resize(RowSize:=iRowSize, ColumnSize:=iColSize)

MyRng.Select

'This is to format main data table Range("F16 to usedrange)
With MyRng
.Font.Name = "Calibri"
.Font.Size = 10
.Font.Bold = False
.Font.ColorIndex = 1

.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeRight).Weight = xlThin

.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlHairline

.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With

'This is to format individual data column as per content
Range("C17").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.HorizontalAlignment = xlLeft

Range("D17").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "0.0"

Range("E17:T17").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"

'This is to format sub header("E16" to usedrange) header
Range("C16:T16").Select

With Selection
.MergeCells = False
.Font.Name = "Calibri"
.Font.Size = 10
.Font.Bold = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 34
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
With Selection

.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeRight).Weight = xlThin

.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin

End With

'This is to format main header range E15
Range("E15").Select
With Selection
.Font.Name = "Calibri"
.Font.Size = 10
.Font.Bold = True
.Font.ColorIndex = 1
.Interior.ColorIndex = 31
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
With Selection
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeRight).Weight = xlThin
End With

Range("A1").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True

Call removebackenddataAllCountry
End Sub

Sub removebackenddataAllCountry()
Application.ScreenUpdating = False
Range("AP18:BG18").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

Range("AP16:BG17").Select
With Selection
.ClearFormats
.Font.ColorIndex = 2
End With
Range("A1").Select
Application.ScreenUpdating = True
End Sub
 
Hi Manish...

Application.ScreenUpdating is the only Application Property..
  • Which doesn't require, a TRUE Statement, if your turned it to FALSE.
  • It automatically turned to FALSE, once you complete the subroutine, and sheet screen is displayed.
  • In between the Subroutine, if you are using a lots of Select statement, the final output will be the last selected cell/sheet
In your code.. just try to remove SELECT statement as much as possible.. may be all..
and try to remove all the Application.ScreenUpdating=True statement..

You may see a blank Excel Application, but swaping between sheet's may be reduced..

By the way..Welcome to the forum..
please upload your file, for testing..

and in the meantime.. have a look here..
http://chandoo.org/forum/forums/new-users-please-start-here.14/
 
You must log in or register to reply here.
Back
Top