A worksheet function applied to all

[BMD]

This is my working function,,,,,, but it only works for Sheet1 and I tryed to copy it to ThisWorkbook but it does not work for any other sheet. Do I realy need to copy it to all sheet and mainten all of them?

Thanks,
This group is excellence,
The Learning, Bruce.

'"Pass" in cell G row A:O Green.
'"Fail" in cell G row A:O Red
'"Pass" in cell G cell M is = "to {Major or Minor}" turn the row A:O Yellow.
Option Compare Text
Public Sub demo()
Letter = "P"
If Letter = "p" Then MsgBox "Case does not matter"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim cell As Range
Dim rng As Range

Set WatchRange = Columns("G")
Set WatchRangeM = Columns("M")
Dim myMultiAreaRange As Range
Set myMultiAreaRange = Union(WatchRange, WatchRangeM)

If Intersect(Target, myMultiAreaRange) Is Nothing Then Exit Sub
Set rng = Intersect(Target, myMultiAreaRange)

For Each cell In rng
With Range(Cells(cell.Row, "A"), Cells(cell.Row, "O")).Font
Select Case LCase(cell):
Case "Pass", "P"
If Cells(cell.Row, "M") = "Major" Or Cells(cell.Row, "M") = "Minor" Or Cells(cell.Row, "M") = "Maj" Or Cells(cell.Row, "M") = "Min" Then
.ColorIndex = 33
.Bold = True
Else
.ColorIndex = 10
.Bold = False
End If
Case "Major", "Maj", "Minor", "Min"
If Cells(cell.Row, "G") = "Pass" Or Cells(cell.Row, "G") = "P" Then
.ColorIndex = 33
.Bold = True
Else
.ColorIndex = 10
.Bold = False
End If
Case "Fail", "F"
.ColorIndex = 3
.Bold = False
Case Else
.ColorIndex = 1
.Bold = False
End Select:
End With
Next cell
End Sub

 

[a7n9]

No, you don't need to copy it to all the worksheets. Just insert a module and copy your macro there.

That's it, you can use this macro from any worksheet and if you want to use it for any workbook copy it into the personal workbook.

 

[Joe Was]

In the VBA Editor Toolbar: Insert - Module
Cut and paste your Function to this Module.

Or if you want to work on the entire workbook add another loop to loop through each sheets data. Note looking at your code though you will need to make other changes depensing on how you want it to work or repost data. So I think you just need to do the above!

 

[erik.van.geit]

Hello, guys,

cut the code in your worksheetmodule
and paste in the workbookmodule

replace this line
Private Sub Worksheet_Change(ByVal Target As Range)
with
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
I didn't test it for your macro, but this is the "general method" to do what (I think) you asked

kind regards,
Erik

EDIT: a tip for BMD: please use the code-button to display code nicely

 

[BMD]

I now have:
VBAProject (book1.xls)
Microsoft Excel Objects
Sheet1 (Sheet1)
Sheet2 (Sheet2)
Sheet3 (Sheet3)
ThisWorkbook
Modules
Module1

when I make a change to sheet two the formatting does not happen. There is nothing code on sheet 1 any more and that sheet is also not working any more.

I could 'Try and try again: "The way of the coder!"'

Thanks,
Bruce.

 

[Seti]

How about creating a WorksheetChange macro in each sheet that calls a macro in module1 rather than duplicating all this code in each sheet?

 

[Norie]

Bruce

You need to reference the sheet that has changed in the SheetChange event in the ThisWorkbook module.

Try something like this, untested code.

Note the parameter Sh which is passed to the code. This is the sheet that the change has been made on.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim WatchRange As Range
Dim WatchRangeM As Range
Dim cell As Range
Dim rng As Range
Dim myMultiAreaRange As Range

Set WatchRange = Sh.Columns("G")
Set WatchRangeM = Sh.Columns("M")

Set myMultiAreaRange = Union(WatchRange, WatchRangeM)

If Intersect(Target, myMultiAreaRange) Is Nothing Then Exit Sub
    
Set rng = Intersect(Target, myMultiAreaRange)

For Each cell In rng

    With Sh.Range(Sh.Cells(cell.Row, "A"), Sh.Cells(cell.Row, "O")).Font
        Select Case LCase(cell):
            Case "Pass", "P"
                Select Case Sh.Cells(cell.Row, "M")
                    Case "Major", "Minor", "Maj", "Min"
                        .ColorIndex = 33
                        .Bold = True
                    Case Else
                        .ColorIndex = 10
                        .Bold = False
                End Select
            Case "Major", "Maj", "Minor", "Min"
                Select Case Sh.Cells(cell.Row, "G")
                    Case "Pass", "P"
                        .ColorIndex = 33
                        .Bold = True
                    Case Else
                        .ColorIndex = 10
                        .Bold = False
                End Select
            Case "Fail", "F"
                .ColorIndex = 3
                .Bold = False
            Case Else
                .ColorIndex = 1
                .Bold = False
        End Select
    End With
Next cell

End Sub

This code should go in the ThisWorkbook module.

To get to that double click on ThisWorkbook under Microsoft Excel Objects in the VBE Project Explorer.

 

[erik.van.geit]

what do you have in your workbook module now?

perhaps you disabled "enable events"
so run this
Sub foo()
Application.EnableEvents = True
End Sub

seti,

How about creating a WorksheetChange macro in each sheet that calls a macro in module1 rather than duplicating all this code in each sheet?

my post used the excel-inbuilt-solution to get the same worksheetchangeevent for each sheet

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
MsgBox "you changed sheets " & Sh.Name
End Sub

does this work for you ?

kind regards,
Erik

 

[BMD]

This is now my whole module1 code. nothing is listed on any sheet. I now have a VBAProject (Book2) under VBAProject (Book1.xls) and I don't know where it came from.

'"Pass" in cell G row A:O Green.
'"Fail" in cell G row A:O Red
'"Pass" in cell G cell M is = "to {Major or Minor}" turn the row A:O Blue and bold.
Option Compare Text
Public Sub demo()
Letter = "P"
If Letter = "p" Then MsgBox "Case does not matter"
End Sub
'Private Sub Worksheet_Change(ByVal Target As Range)
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim WatchRange As Range
Dim cell As Range
Dim rng As Range

Set WatchRange = Columns("G")
Set WatchRangeM = Columns("M")
Dim myMultiAreaRange As Range
Set myMultiAreaRange = Union(WatchRange, WatchRangeM)

If Intersect(Target, myMultiAreaRange) Is Nothing Then Exit Sub
Set rng = Intersect(Target, myMultiAreaRange)

For Each cell In rng
    With Range(Cells(cell.Row, "A"), Cells(cell.Row, "O")).Font
        Select Case LCase(cell):
        Case "Pass", "P"
            If Cells(cell.Row, "M") = "Major" Or Cells(cell.Row, "M") = "Minor" Or Cells(cell.Row, "M") = "Maj" Or Cells(cell.Row, "M") = "Min" Then
            .ColorIndex = 33
            .Bold = True
            Else
            .ColorIndex = 10
            .Bold = False
            End If
        Case "Major", "Maj", "Minor", "Min"
            If Cells(cell.Row, "G") = "Pass" Or Cells(cell.Row, "G") = "P" Then
            .ColorIndex = 33
            .Bold = True
            Else
            .ColorIndex = 10
            .Bold = False
            End If
        Case "Fail", "F"
            .ColorIndex = 3
            .Bold = False
        Case Else
            .ColorIndex = 1
            .Bold = False
        End Select:
    End With
Next cell
End Sub

Sub foo()
Application.EnableEvents = True
End Sub

Bruce.

 

[Norie]

Bruce

Did you try the code I posted?