Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Multiple Worksheet_Change events in vba code

Tags:

excel

vba

I'm having problems merging two Worksheet_Change events - could I please get some advice from a guru?

The aim of the code is to convert any uppercase text in the cell ranges given to lowercase, but obviously I can't have two events.

I've tried copying both into the same Worksheet_Change, but Excel goes berzerk and crashed.

Range 1:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ccr As Range
    Set ccr = Range("C6")
    For Each Cell In ccr
    Cell.Value = LCase(Cell)
    Next Cell
End Sub

Range 2:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim acr As Range
    Set acr = Range("C9:G9")
    For Each Cell In acr
    Cell.Value = LCase(Cell)
    Next Cell
End Sub

Many thanks

like image 512
user3722957 Avatar asked Feb 13 '19 14:02

user3722957


2 Answers

The main issue is that changing a cell value Cell.Value will trigger another Worksheet_Change immediately. You need to Application.EnableEvents = False to prevent this.

Also I recommend to work with Intersect so the code only runs on the cells that are actually changed.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim AffectedRange As Range
    Set AffectedRange = Intersect(Target, Target.Parent.Range("C6, C9:G9"))

    If Not AffectedRange Is Nothing Then
        Application.EnableEvents = False 'pervent triggering another change event

        Dim Cel As Range
        For Each Cel In AffectedRange.Cells
            Cel.Value = LCase$(Cel.Value)
        Next Cel

        Application.EnableEvents = True 'don't forget to re-enable events in the end
    End If
End Sub

In addition to @Frank Ball's comment including error handling:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim AffectedRange As Range
    Set AffectedRange = Intersect(Target, Target.Parent.Range("C6, C9:G9"))

    Application.EnableEvents = False 'pervent triggering another change event
    On Error GoTo ERR_HANDLING

    If Not AffectedRange Is Nothing Then
        Dim Cel As Range
        For Each Cel In AffectedRange.Cells
            Cel.Value = LCase$(Cel.Value)
        Next Cel
    End If

    On Error GoTo 0

    'no Exit Sub here!
ERR_HANDLING:
    Application.EnableEvents = True 

    If Err.Number <> 0 Then
        Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
    End If
End Sub
like image 147
Pᴇʜ Avatar answered Sep 18 '22 01:09

Pᴇʜ


Like this you can do both the things in same event

You have to add Application.EnableEvents = False at the starting to avoid race condition.

Private Sub Worksheet_Change(ByVal Target As Range)
 Application.EnableEvents = False

    Dim ccr As Range, acr as Range

    Set ccr = Range("C6")
    For Each Cell In ccr
      Cell.Value = LCase(Cell)
    Next Cell

    Set acr = Range("C9:G9")
    For Each Cell In acr
      Cell.Value = LCase(Cell)
    Next Cell
 Application.EnableEvents = True

End Sub
like image 42
Stupid_Intern Avatar answered Sep 22 '22 01:09

Stupid_Intern