CODEWITHSUNDEEP
excelvba
Owen4512
Owen4512

Reputation: 13

Combining Worksheet_Change events in vba code

I require some help in combining two Worksheet_Change events. Event 1 will reformat the cell to the correct postcode format & event 2 will apply the proper function. How can i combine event 1 & 2 in order for both to work at the same time?

Any help would be greatly appreciated :)

Event 1

    Private Sub Worksheet_Change(ByVal Target As Range)

    On Error Resume Next
    
    If Intersect(Target, Range("K17")) Is Nothing Then Exit Sub
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "[A-Z]{1,2}[0-9]{1,2}\s[0-9][A-Z]{2}"
        If Not .test(Cells(17, 11)) Then
            Cells(17, 11) = UCase(Left(Cells(17, 11), Len(Cells(17, 11)) - 3) & " " & Right(Cells(17, 11), 3))
    End If
    End With
End Sub

Event 2

Private Sub Worksheet_Change2(ByVal Target As Range)

If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub

    On Error Resume Next

    If Not Intersect(Target, Range("F7;K7")) Is Nothing Then

        Application.EnableEvents = False

        Target = StrConv(Target, vbProperCase)

        Application.EnableEvents = True

    End If
    
    End Sub

Upvotes: 0

Views: 120

Answers (1)

pgSystemTester
pgSystemTester

Reputation: 9897

Why not just split into two independent macros that each run during the Change event? The below might work. I'd be careful about doing .cells.count as that can be a lot if you delete an entire column or a wide range of data.

Private Sub Worksheet_Change(ByVal Target As Range)
    Call macroFirst(Target)
    Call macroSecond(Target)
End Sub

Private Sub macroFirst(ByVal Target As Range)
    On Error Resume Next
    
    If Intersect(Target, Range("K17")) Is Nothing Then Exit Sub
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "[A-Z]{1,2}[0-9]{1,2}\s[0-9][A-Z]{2}"
        If Not .test(Cells(17, 11)) Then
            Cells(17, 11) = UCase(Left(Cells(17, 11), Len(Cells(17, 11)) - 3) & " " & Right(Cells(17, 11), 3))
    End If
    End With

End Sub

Private Sub macroSecond(ByVal Target As Range)
    If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
        On Error Resume Next
        If Not Intersect(Target, Range("F7;K7")) Is Nothing Then
            Application.EnableEvents = False
            Target = StrConv(Target, vbProperCase)
            Application.EnableEvents = True
    End If
    
End Sub

Upvotes: 2

Related Questions