Converting Worksheet VBA to all Sheets

user_14536667 0
Viewed 53

I am trying to take some code is functioning on a single sheet and convert it so that it applies to all worksheets in the book. I thought I could move the code a module and then use the Workbook_SheetChange "wrapper" described in Worksheet change event for every sheet in the workbook. However, the Multiple Select dropdown still only works on the original sheet, despite the "Named_Range" being defined on all sheets.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    With Sh
        Dim OldVal As String
        Dim NewVal As String
    
        ' If more than 1 cell is being changed
        If Target.Count > 1 Then Exit Sub
        If Target.Value = "" Then Exit Sub
        If Not Intersect(Target, ActiveSheet.Range("Named_Range")) Is Nothing Then
            ' Turn off events so our changes don't trigger this event again
            Application.EnableEvents = False
            NewVal = Target.Value
            
            ' If there's nothing to undo this will cause an error
            On Error Resume Next
            Application.Undo
            On Error GoTo 0
            OldVal = Target.Value
            ' If selection is already in the cell we want to remove it
            
            If InStr(OldVal, NewVal) Then
                'If there's a comma in the cell, there's more than one word in the cell
                If InStr(OldVal, ",") Then
                    If InStr(OldVal, ", " & NewVal) Then
                        Target.Value = Replace(OldVal, ", " & NewVal, "")
                    Else
                        Target.Value = Replace(OldVal, NewVal & ", ", "")
                    End If
                Else
                    ' If we get to here the selection was the only thing in the cell
                    Target.Value = ""
                End If
            
            Else
                If OldVal = "" Then
                    Target.Value = NewVal
                Else
                    ' Delete cell contents
                    If NewVal = "" Then
                        Target.Value = ""
                    Else
                        ' This IF prevents the same value appearing in the cell multiple times
                        ' If you are happy to have the same value multiple times remove this IF
                        If InStr(Target.Value, NewVal) = 0 Then
                            Target.Value = OldVal & ", " & NewVal
                        End If
                    End If
                End If
            End If
            Application.EnableEvents = True
                
        Else
            Exit Sub
        End If
        
    End With
End Sub
module vba excel
1 Answers

Regular modules don't have events. They are host agnostic. The SheetChange event is in the workbook object. So this means you must place your code into the ThisWorkBook object.

enter image description here

Now looking at your code I see a With Sh block that does nothing. You never use that object. The only place where it makes sense to use the sheet object is where you cite ActiveSheet. We always want to use Sh and we never want to assume that the correct sheet is active.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim OldVal As String
    Dim NewVal As String

    ' If more than 1 cell is being changed
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If Not Intersect(Target, Sh.Range("Named_Range")) Is Nothing Then
        ' Turn off events so our changes don't trigger this event again
        Application.EnableEvents = False
        NewVal = Target.Value
        
        ' If there's nothing to undo this will cause an error
        On Error Resume Next
        Application.Undo
        On Error GoTo 0
        OldVal = Target.Value
        
        ' If selection is already in the cell we want to remove it
        If InStr(OldVal, NewVal) Then
            'If there's a comma in the cell, there's more than one word in the cell
            If InStr(OldVal, ",") Then
                If InStr(OldVal, ", " & NewVal) Then
                    Target.Value = Replace(OldVal, ", " & NewVal, "")
                Else
                    Target.Value = Replace(OldVal, NewVal & ", ", "")
                End If
            Else
                ' If we get to here the selection was the only thing in the cell
                Target.Value = ""
            End If
        Else
            If OldVal = "" Then
                Target.Value = NewVal
            Else
                ' Delete cell contents
                If NewVal = "" Then
                    Target.Value = NewVal
                Else
                    ' This IF prevents the same value appearing in the cell multiple times
                    ' If you are happy to have the same value multiple times remove this IF
                    If InStr(Target.Value, NewVal) = 0 Then
                        Target.Value = OldVal & ", " & NewVal
                    End If
                End If
            End If
        End If
        
        Application.EnableEvents = True
    Else
        Exit Sub
    End If
End Sub

Finally, there is a logic flaw at the bottom of your if tree. If oldval is not in newval, oldval is not blank and new val is not blank you end up in that final place where it optinally adds a comma. If the that isn't needed then you're in a state where you have run .Undo on the change and you haven't set Target.Value at all. This might make it so you can't change the contents of a cell to a new value. I'm not sure if you intended that behavior.

user_81738700
Related