Doubt in Worksheet Activate Event

[madhuchelliah]

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?

 

[My Aswer Is This]

Show us your scripts

 

[madhuchelliah]

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

 

[My Aswer Is This]

This is beyond my knowledgebase.
I will continue to monitor this thread to see what I can learn.

 

[Joe4]

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:

Application.EnableEvents = False

and then be sure to turn them back on at the end of your code like this:

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:

Sub TurnEventsOn()
    Application.EnableEvents = True
End Sub

 

[madhuchelliah]

Thanks Joe, its working great.