Multiple Private Sub Worksheet_Change

armroo

New Member
Joined
Mar 14, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I have a tracker which has options which move a row to another sheet in the workbook based on the selection.

For example, in Column F if I select "Booked" it will move the row into the Booked tab. I also have a "Remove from Tracker" option which deletes the row.

Here's the code I'm using:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error GoTo errHandler
    If Target = "Booked" Then
        Call Booked_UnProtectSheet
        Call Bucket1_UnProtectSheet
        Range("A" & Target.Row & ":K" & Target.Row).Copy Sheets("Booked").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        Target.EntireRow.Delete
        Call Booked_ProtectSheet
        Call Bucket1_ProtectSheet
    ElseIf Target = "Remove from Tracker" Then
    Call Bucket1_UnProtectSheet
    Target.EntireRow.Delete
    Call Bucket1_ProtectSheet
End If
errHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
I have sub statuses in Column G which I want to move to the other sheets based on the selection.

For example, when I select "Archive" in column F, I want to be able to select "Pharmacy" from column G and then have it move to the "Bucket 3" sheet. However, as this is a different Worksheet Change, i'm not able to add it to the current VBA code.

I would also like to add this code so it clears Column G once another selection is made in Column F. Here's the code for that:

VBA Code:
Private Sub Worksheet_Change1(ByVal Target As Range)
On Error Resume Next
If Target.Column = 6 Then
 If Target.Validation.Type = 3 Then
 Application.EnableEvents = False
 Target.Offset(0, 1).ClearContents
 End If
End If
exitHandler:
 Application.EnableEvents = True
 Exit Sub
End Sub
If you could assist in combining the 3 codes I will be forever grateful. Thank you!
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,583
Office Version
  1. 2013
Platform
  1. Windows
Here is a simple example that may help you:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  3/15/2021  3:10:52 AM  EDT
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub

If Target.Column = 1 Then
    If Target.Value = "Yes" Then Target.Offset(, 1).Value = "No"
End If

If Target.Column = 5 Then
    If Target.Value = "You" Then Target.Offset(, 1).Value = "Me"
End If

End Sub
 

armroo

New Member
Joined
Mar 14, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Here is a simple example that may help you:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  3/15/2021  3:10:52 AM  EDT
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub

If Target.Column = 1 Then
    If Target.Value = "Yes" Then Target.Offset(, 1).Value = "No"
End If

If Target.Column = 5 Then
    If Target.Value = "You" Then Target.Offset(, 1).Value = "Me"
End If

End Sub
Hi
Here is a simple example that may help you:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  3/15/2021  3:10:52 AM  EDT
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub

If Target.Column = 1 Then
    If Target.Value = "Yes" Then Target.Offset(, 1).Value = "No"
End If

If Target.Column = 5 Then
    If Target.Value = "You" Then Target.Offset(, 1).Value = "Me"
End If

End Sub
Thanks for your reply. However, I'm not sure I quite understand - can you please provide some context?
 

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,400
Office Version
  1. 365
Platform
  1. Windows
Id use Select Case for that such as:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   
If Intersect(Target, Range("F:F")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo errHandler

Select Case UCase(Target.Value)
    Case "BOOKED"
        Call Booked_UnProtectSheet
        Call Bucket1_UnProtectSheet
        Range("A" & Target.Row & ":K" & Target.Row).Copy Sheets("Booked").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        Target.EntireRow.Delete
        Call Booked_ProtectSheet
        Call Bucket1_ProtectSheet
    Case "REMOVE FROM TRACKER"
        Call Bucket1_UnProtectSheet
        Target.EntireRow.Delete
        Call Bucket1_ProtectSheet
    Case "ARCHIVE"
        If Target.Offset(0, 1) = "Pharmacy" Then
            'do this, could always be another Select Case if lots of options.
        End If
    Case Else
        'do this
End Select

errHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
 

armroo

New Member
Joined
Mar 14, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Id use Select Case for that such as:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  
If Intersect(Target, Range("F:F")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo errHandler

Select Case UCase(Target.Value)
    Case "BOOKED"
        Call Booked_UnProtectSheet
        Call Bucket1_UnProtectSheet
        Range("A" & Target.Row & ":K" & Target.Row).Copy Sheets("Booked").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        Target.EntireRow.Delete
        Call Booked_ProtectSheet
        Call Bucket1_ProtectSheet
    Case "REMOVE FROM TRACKER"
        Call Bucket1_UnProtectSheet
        Target.EntireRow.Delete
        Call Bucket1_ProtectSheet
    Case "ARCHIVE"
        If Target.Offset(0, 1) = "Pharmacy" Then
            'do this, could always be another Select Case if lots of options.
        End If
    Case Else
        'do this
End Select

errHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
Hi @steve the fish ,
This is great, however, when I select ARCHIVE then Pharmacy, it doesn't move to Bucket 3. However if I choose ARCHIVE, then Pharmacy, then hit ARCHIVE again it does move.
Here's the code I've used. Any suggestions to make it move to sheet Bucket 3 without having to select ARCHIVE again?

VBA Code:
    Case "ARCHIVE"
        If Target.Offset(, 1) = "Pharmacy" Then
            'do this, could always be another Select Case if lots of options.
        Call Bucket3_UnProtectSheet
        Call Bucket1_UnProtectSheet
        Range("A" & Target.Row & ":L" & Target.Row).Copy Sheets("Bucket3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        Target.EntireRow.Delete
        Call Bucket3_ProtectSheet
        Call Bucket1_ProtectSheet
        End If
 

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,400
Office Version
  1. 365
Platform
  1. Windows
Ok thats because you have no trigger on column 7 so changing that wont cause anything to happen. The trigger is on column 6. You could use something like this maybe:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   
If Intersect(Target, Range("F:G")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo errHandler

Select Case Target.Column
    Case 6
        Select Case UCase(Target.Value)
            Case "BOOKED"
                'do this
            Case "REMOVE FROM TRACKER"
                'do this
            Case "ARCHIVE"
                If UCase(Target.Offset(0, 1)) = "PHARMACY" Then
                    'do this
                End If
            Case Else
                'do this
        End Select
    Case 7
        Select Case UCase(Target.Value)
            Case "PHARMACY"
                If UCase(Target.Offset(0, -1)) = "ARCHIVE" Then
                    'do this
                End If
            Case Else
                'do this
        End Select
End Select
        
errHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,130,014
Messages
5,639,555
Members
417,098
Latest member
steverob

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
Top