VBA Macro not working in multiple worksheets within workbook

Question

I work for a communications company and I am trying to run code on an Excel document that has compiled data about trouble reports on products.

The macros I want to run will generate a risk spider chart for each data set when you click across the columns (months).

The macro I have works in the first worksheet but I can't get it to work in the second worksheet when it is essentially the same data.

I would appreciate any help I can get!!

This is the code I have:

Private Sub Worksheet_Calculate()

    Call UpdateTotalRatings

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$B$14" Then
        Call UpdateTotalRatings
    End If
End Sub

Private Sub UpdateTotalRatings()

Dim Cell As Range
Dim LastCol As String

    Application.ScreenUpdating = False

    ' Ensure number of colours is valid (must be 3 or 6).
    If ActiveSheet.Range("B14").Value <> 3 And _
       ActiveSheet.Range("B14").Value <> 6 Then
        ActiveSheet.Range("B14").Value = 3
    End If

    ' Determine right-most column.
     LastCol = Mid(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Address, 2, 1)

    For Each Cell In Range("B13:" & LastCol & "13")
        If IsNumeric(Cell.Value) Then
            Cell.Interior.Color = ThisWorkbook.GetColour(Cell.Value, _
            ActiveSheet.Range("B14").Value)
        End If
    Next
    Application.ScreenUpdating = True

 End Sub

Answer 1

If you put your code (with some changes) into the ThisWorkbook module, it will work on every sheet in the workbook.

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

    UpdateTotalRankings Sh

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    If Target.Address = "$B$14" Then
        UpdateTotalRankings Sh
    End If

End Sub

Private Sub UpdateTotalRankings(Sh As Object)

    Dim rCell As Range
    Dim lLastCol As Long

    Application.ScreenUpdating = False

    ' Ensure number of colours is valid (must be 3 or 6).
    If Sh.Range("B14").Value <> 3 And _
        Sh.Range("B14").Value <> 6 Then

        Sh.Range("B14").Value = 3
    End If

    ' Determine right-most column.
    lLastCol = Sh.Cells.SpecialCells(xlCellTypeLastCell).Column

    For Each rCell In Sh.Range("B13").Resize(1, lLastCol - 1).Cells
        If IsNumeric(rCell.Value) Then
            rCell.Interior.Color = Me.GetColour(rCell.Value, _
                Sh.Range("B14").Value)
        End If
    Next rCell

    Application.ScreenUpdating = True

End Sub

If you have sheets that you don't want to process, you can check the Sh argument. Maybe it's based on the sheet name

If Sh.Name Like "Report_*" Then

will only process sheets whose names start with Report_. Or

If Sh.Range("A14").Value = "Input" Then

to check a cell (like A14) that has a particular value to identify sheets to process.

Answer 2

This procedure Worksheet_Change is an event procedure.

It is supposed to (and can) be only in the corresponding Worksheet Module. That's why your code doesn't work for your other sheets.

In order to get it work, you need to :

• understand what you intend to do with your VBA
• call the event procedure on every Worksheet module where this is needed
• use a main procedure you will store in a "code" standard module (can't remember the right name here)
• use range arguments to pass the Target of the procedure (or at least the right worksheet) to the main procedure

----- EDIT --------

First, change

Private Sub UpdateTotalRatings()

to

Sub UpdateTotalRatings(Optional ByVal Target As Range)

Then, move all the Sub UpdateTotalRatings(Optional ByVal Target As Range) to a module

And, in every worksheet module, add:

Private Sub Worksheet_Calculate()

    Call UpdateTotalRatings

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$B$14" Then
        Call UpdateTotalRatings(Target)
    End If
End Sub