Doubt in Worksheet Activate Event

madhuchelliah

Board Regular
Joined
Nov 22, 2017
Messages
226
Office Version
  1. 2019
Platform
  1. Windows
Hello all, I am calling 3 macros from module using worksheet activate event. My problem is those 3 macros repeating continuously not stopping after running the 3rd macro. What might be the issue? Am i missing anything?
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Code:
Sub FPQMETER()
Worksheets("CHART DATA").PivotTables("Pivot_Accountablility").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("Pivot_FPQ").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("Pivot_Avg_FPQ").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("Pivot_OTD").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("Pivot_Avg_OTD").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("Pivot_Aggregate").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("Pivot_Error_Description").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("Pivot_Efficiency").PivotCache.Refresh
Dim str As String
Dim val As Long
Dim inte As Single
Dim subss As String
Dim Csht As Worksheet
Dim Dsht As Worksheet
Dim Esht As Worksheet
Dim LastRow     As Long
Dim LastColumn  As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Set Csht = ThisWorkbook.Sheets("CHART DATA")
Set Dsht = ThisWorkbook.Sheets("DASH BOARD")
Set Esht = ThisWorkbook.Sheets("DATA SHEET")
'Sheets("CHART DATA").Select
'Sheets("Sheet1").Select
With Csht
    '.Activate
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
                  'Loop through all the rows of the sheet that contain commands.
        For i = 1 To LastRow
        LastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column
        For j = 1 To LastColumn
        subss = .Cells(i, j).Value
        ActiveSheet.Cells(i, j).Select
              If subss = "% of FIRST_PASS_QUALITY" Then
                k = i
                k = k + 1
                str = .Cells(k, j).Value
                'MsgBox str
                'val = str
                inte = str * 100
                inte = Round(inte, 2)
                With Dsht
                .Activate 'Sheets("DASH BOARD").Select
                ActiveSheet.Shapes.Range(Array("Group 78")).Select
                    Selection.ShapeRange.Rotation = str * 210
                    ActiveSheet.Shapes.Range(Array("TextBox 91")).Select
                    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = inte & "%"
                    End With
            End If
          Next j
          Next i
          End With
          Range("A1").Select
With Esht
.Activate
End With
End Sub



Sub OTDMETER()
Worksheets("CHART DATA").PivotTables("Pivot_Accountablility").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("Pivot_FPQ").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("Pivot_Avg_FPQ").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("Pivot_OTD").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("Pivot_Avg_OTD").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("PivotTable7").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("PivotTable8").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("PivotTable11").PivotCache.Refresh
Dim str As String
Dim val As Long
Dim inte As Single
Dim subss As String
Dim Csht As Worksheet
Dim Dsht As Worksheet
Dim Esht As Worksheet
Dim LastRow     As Long
Dim LastColumn  As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Set Csht = ThisWorkbook.Sheets("CHART DATA")
Set Dsht = ThisWorkbook.Sheets("DASH BOARD")
Set Esht = ThisWorkbook.Sheets("DATA SHEET")
'Sheets("CHART DATA").Select
'Sheets("Sheet1").Select
With Csht
    .Activate
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'finding the lastrow of the worksheet.
        For i = 1 To LastRow        'Loop through all the rows of the sheet.
        LastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column 'finding the last column of the worksheet.
        For j = 1 To LastColumn  'Loop through all the columns of the row.
        subss = .Cells(i, j).Value ' gets the value on the respective cell.
        'ActiveSheet.Cells(i, j).Select
              If subss = "% of ON_TIME_DELIVERY" Then ' checks whether the cell contains the particular text.
                k = i
                k = k + 1
                str = .Cells(k, j).Value
                inte = str * 100
                inte = Round(inte, 2)
                With Dsht
                .Activate
                'Sheets("DASH BOARD").Select
                ActiveSheet.Shapes.Range(Array("Group 46")).Select
                    Selection.ShapeRange.Rotation = str * 210 ' changes the rotation.
                    ActiveSheet.Shapes.Range(Array("TextBox 15")).Select
                    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = inte & "%" ' changes the content of the text box.
                    End With
            End If
          Next j
          Next i
          End With
          Range("A1").Select
With Esht
.Activate
End With
End Sub



Sub EFFMETER()
Worksheets("CHART DATA").PivotTables("Pivot_Accountablility").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("Pivot_FPQ").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("Pivot_Avg_FPQ").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("Pivot_OTD").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("Pivot_Avg_OTD").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("PivotTable7").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("PivotTable8").PivotCache.Refresh
Worksheets("CHART DATA").PivotTables("PivotTable11").PivotCache.Refresh
Dim str As String
Dim val As Long
Dim inte As Single
Dim subss As String
Dim Csht As Worksheet
Dim Dsht As Worksheet
Dim Esht As Worksheet
Dim LastRow     As Long
Dim LastColumn  As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Set Csht = ThisWorkbook.Sheets("CHART DATA")
Set Dsht = ThisWorkbook.Sheets("DASH BOARD")
Set Esht = ThisWorkbook.Sheets("DATA SHEET")
'Sheets("CHART DATA").Select
'Sheets("Sheet1").Select
With Csht
    .Activate
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'finding the lastrow of the worksheet.
        For i = 1 To LastRow        'Loop through all the rows of the sheet.
        LastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column 'finding the last column of the worksheet.
        For j = 1 To LastColumn  'Loop through all the columns of the row.
        subss = .Cells(i, j).Value ' gets the value on the respective cell.
        'ActiveSheet.Cells(i, j).Select
              If subss = "AVERAGE EFFICIENCY" Then ' checks whether the cell contains the particular text.
                k = i
                k = k + 1
                str = .Cells(k, j).Value
                inte = str * 100
                inte = Round(inte, 2)
                With Dsht
                .Activate
                'Sheets("DASH BOARD").Select
                ActiveSheet.Shapes.Range(Array("Group 152")).Select
                    Selection.ShapeRange.Rotation = (str / 2) * 210 ' changes the rotation.
                    ActiveSheet.Shapes.Range(Array("TextBox 172")).Select
                    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = inte & "%" ' changes the content of the text box.
                    End With
            End If
          Next j
          Next i
          End With
          Range("A1").Select
With Esht
.Activate
End With
End Sub
 
Last edited:
Upvote 0
This is beyond my knowledgebase.
I will continue to monitor this thread to see what I can learn.
 
Upvote 0
At first glance, it looks like your code is working with different worksheets. This may cause your Worksheet_Activate event to keep re-firing, and get caught in an infinite loop.
If you have VBA code that may trigger those event procedures to fire again, you need to add code to temporarily disable events while that code is running.
The way it is typically done is to add the following line to the top of the offending Sub procedure:
Code:
Application.EnableEvents = False
and then be sure to turn them back on at the end of your code like this:
Code:
Application.EnableEvents = True
It might be best to do this in all three procedures.

Note: Also be sure that the last part ALWAYS runs. If you should have an error or exit the sub before you turn Events back on, the automated code won't run automatically anymore (unless you re-enable it again!).

So, if you are using this kind of code, and suddenly find your event code isn't firing anymore, this is probably what happened. You can re-enable them by manually running a simple procedure like this:
Code:
Sub TurnEventsOn()
    Application.EnableEvents = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,216,077
Messages
6,128,685
Members
449,463
Latest member
Jojomen56

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