Combine 2 separate VBA

wikiriki

New member
Joined
May 28, 2021
Messages
1
Reaction score
0
Points
0
Excel Version(s)
MS 365
Hi, i am new to VBA and need some assistance.

I wanted to lock cells for a certain range (below):
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range
    On Error Resume Next
    Set xRg = Intersect(Range("A1:A10,C1:C10,E1:E10"), Target)
    If xRg Is Nothing Then Exit Sub
    Target.Worksheet.Unprotect Password:="0"
    If xRg.Value <> mStr Then xRg.Locked = True
    Target.Worksheet.Protect Password:="0"
End Sub

And also make certain cells to force uppercase on them (below):
Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rngCell As Range
    If Intersect(Target, Range("B1:B1O,D1,F1")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Each rngCell In Target.Cells
    rngCell = UCase(rngCell)
    Next
    Application.EnableEvents = True
End Sub

The codes are able to function separately but when i combined them together, there is an error and I learnt that [highlight]Worksheet_Change[/highlight] cannot have duplicates. How do i combine them together in order to work? Kindly advise.
Have attached the excel document for my codes. Thank you.
 

Attachments

  • Sample.xlsm
    14.9 KB · Views: 8
Place all the code inside one Private Sub Worksheet_Change(ByVal Target As Range)
 
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
Dim cell As Range
    
    On Error GoTo wc_Exit
    Application.EnableEvents = False
    
    Me.Unprotect Password:="0"
    
    Set xRg = Intersect(Range("A1:A10,C1:C10,E1:E10"), Target)
    If Not xRg Is Nothing Then
    
        If xRg.Value <> mStr Then xRg.Locked = True
    ElseIf Not Intersect(Target, Range("B1:B1O,D1,F1")) Is Nothing Then
    
        For Each rngCell In Target.Cells
        
            cell.Value = UCase(cell.Value)
        Next
    End If
    
wc_Exit:
    Me.Protect Password:="0"
    Application.EnableEvents = True
End Sub
 
Back
Top