VBA - Run code on multiple sheets

nitrammada

Board Regular
Joined
Oct 10, 2018
Messages
78
Office Version
  1. 365
Platform
  1. Windows
Hi Everyone,

On Worksheet Change I'm using the intersect method of a range and target address to run my code if cells within the range are changed.
I found this in the FAQ's (many thanks) and it works fine. My challenge is, and this is where I need help, I have many sheets within my workbook that all have exactly the same layout and all have exactly the same range that, if changed, requires a macro to run.

Can anyone help me as to how I can get my macro to run on any one of these sheets should it be changed within the specified range? Some thing that may help, is that out of the many sheets contained within the Workbook, the sheets that require the macro to run, all have 'L2' in cell A1. I figure this might assist as an index to identify the sheets the require the macro to run on change. And it will only be required to run when the sheet is active.

Any help would be appreciated.

Thanks in advance
Adam
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Instead of a worksheet event use a workbook event in the ThisWorkbook module. It will detect the selection change in whatever sheet it happens.

Check the event:

VBA Code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
 
Upvote 0
Solution
Instead of a worksheet event use a workbook event in the ThisWorkbook module. It will detect the selection change in whatever sheet it happens.

Check the event:

VBA Code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Fantastic, thank you Michael, I didn't even know that existed, shows how dumb I am. It works as you said, however, it does run every time I select a cell within my specified range, is there a way it will only run if the cell value is changed?
 
Upvote 0
Ah Ha! Michael, I think I just found it
VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
it seems to work, thank you again, you have taught me so much by pointing me in this direction. Greatly appreciated.
Kind regards
Adam
 
Upvote 0
You would have to modify your original code to be restricted to that one cell and / or exit sub if any other cell was changed .
Maybe you should post the code you are tryring to use.
 
Upvote 0
Hi Michael, sure, always welcome any suggestions.

The code below identifies the range in the sheets I want to run the code on. It calls CheckCode3, that in turn calls CheckCode4 that in turn calls CheckCode5. Convoluted I know but it works and with my limited knowledge it's the best I can do. Essentially CheckCode3 tests if column Y has a value in it and returns a Y or N in column B.
CheckCode4 is testing if codes are missing from my data in columns J through to L. CheckCode5 then tests column B if all Y then colour cell B5 green to show user that all coding is complete, if column B contains a N then colour cell B5 red to show user that coding is incomplete.

The function you helped me with runs all the code below to re-populate column B with a Y or N as the user inserts the correct codes in column J through to L. Hope that makes sense.

VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Not Application.Intersect(Range("J7:L1000"), Range(Target.Address)) Is Nothing Then
        Call CheckCode3
    End If
End Sub

VBA Code:
Sub CheckCode3()
    Application.ScreenUpdating = False
        Dim Count, i As Long
        Count = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
        'MsgBox Count
        i = 7
        If Range("A1").Value = "L2" Then
            Do While i <= Count
                If Cells(i, 25).Value = 0 Or Cells(i, 25).Value = "" Then
                    Range(Cells(i, 2), Cells(i, 2)).Value = "Y"
                    Cells(i, 2).Interior.Color = 16777215
                    Cells(i, 2).Interior.Pattern = xlNone
                    
                    Else
                    Cells(i, 2).Value = "N"
                    Cells(i, 2).Interior.Color = 5263615
                End If
            i = i + 1
            Loop
        End If
    Application.ScreenUpdating = True
    Call CheckCode4
End Sub

VBA Code:
Sub CheckCode4()
Application.ScreenUpdating = False
Dim Count, i As Long
Count = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
'MsgBox Count
i = 7
    If Range("A1").Value = "L2" Then
        Do While i <= Count
            If Cells(i, 2).Value = "N" And Cells(i, 10).Value <> 0 And Cells(i, 11).Value <> 0 And Cells(i, 12).Value <> 0 Or Cells(i, 15).Font.Bold = True Then
            Range(Cells(i, 2), Cells(i, 2)).Value = "Y"
            Range(Cells(i, 2), Cells(i, 2)).Interior.Color = 16777215
            Range(Cells(i, 2), Cells(i, 2)).Interior.Pattern = xlNone
            
            ElseIf Cells(i, 25).Value = 0 Or Cells(i, 25).Value = "" Then
            Range(Cells(i, 2), Cells(i, 2)).Value = "Y"
            End If
        i = i + 1
        Loop
    End If
Call CheckCode5
Application.ScreenUpdating = True
End Sub

VBA Code:
Sub CheckCode5()
'New If to give Y/N in cell B6
Application.ScreenUpdating = False

'declare variables
Dim ws As Worksheet
Dim Rng As Range
Dim cell As Range
Set ws = Worksheets(ActiveSheet.Name)
Set Rng = ws.Range("B7:B100")
'calculate if a range contains Y or N
    For Each cell In Rng
        If cell.Value = "N" Then
        'ws.Range("B6") = "N"
        ws.Range("B5").Interior.Color = 5263615
    Exit For
        Else
        'ws.Range("B6") = "Y"
        ws.Range("B5").Interior.Color = 9359529
        End If
    Next cell
            
Range("F9").Select
Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,521
Messages
6,114,104
Members
448,548
Latest member
harryls

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