Objective: trigger two separate worksheet_change(ByVal Target as Range)
macros to copy data and paste into different tabs when:
- column J range = "Closed" ; and
- column G range is edited in any way.
The VBA below appears to be working for (1). But (2) appears only to be triggering the macro when the column G cell's data is deleted rather than input.
Option Explicit
Private Sub worksheet_change(ByVal target As Range)
'Declare variables
Dim CompletionDate As String
Dim MsgGP As String
Dim TitleMsg As String
Dim CompletionComments As String
Dim MsgGP2 As String
Dim TitleMsg2 As String
Dim RevisedDate As String
Dim RevisedComments As String
Dim MsgGP3 As String
Dim TitleMsg3 As String
TitleMsg = "xx" 'Define InputBox text strings
MsgGP = "xx"
TitleMsg2 = "Road to $$"
MsgGP2 = "xx"
TitleMsg3 = "Task Deferral"
MsgGP3 = "Deferral due to:"
If Not Application.Intersect(target, Range("J" & ActiveCell.Row)) Is Nothing And InStr(1, Range("J" & ActiveCell.Row), "Closed") > 0 Then
'If column J has changed and equals closed
CompletionDate = Application.InputBox(MsgGP, TitleMsg, FormatDateTime(Date, vbShortDate), Type:=1) 'Create Input box to enter completion date
If CompletionDate = "False" Then Exit Sub
CompletionComments = Application.InputBox(MsgGP2, TitleMsg2, Type:=0) 'Create Input box to enter completion comments
If CompletionComments = "False" Then Exit Sub
Sheets("Plan").Range("B" & ActiveCell.Row & ":H" & ActiveCell.Row).Copy 'Copy columns B to H
Sheets("Closed").Select 'Select other worksheet
Sheets("Closed").Range("i" & Rows.Count).End(xlUp).Offset(1) = CompletionDate 'Enter completion date
Sheets("Closed").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues 'Paste work task data
Sheets("Closed").Range("j" & Rows.Count).End(xlUp).Offset(1) = CompletionComments 'Paste completion comments
Sheets("Plan").Activate 'Open Plan worksheet
Sheets("Plan").Range("D" & ActiveCell.Row & ":AV" & ActiveCell.Row).ClearContents 'Clear Contents in selected row
Sheets("Plan").Activate 'Open Plan worksheet
End If
If Not Intersect(target, target.Worksheet.Range("G" & ActiveCell.Row)) Is Nothing Then
RevisedComments = Application.InputBox(MsgGP3, TitleMsg3, Type:=0) 'Create Input box to enter completion comments
If RevisedComments = "False" Then Exit Sub
Sheets("Plan").Range("B" & ActiveCell.Row - 1 & ":H" & ActiveCell.Row - 1).Copy 'Copy columns B to H
Sheets("Revised").Select 'Select other worksheet
Sheets("Revised").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues 'Paste work task data
Sheets("Revised").Range("j" & Rows.Count).End(xlUp).Offset(1) = RevisedComments 'Paste completion comments
Sheets("Plan").Activate 'Open Plan worksheet
End If
End Sub
I'm sure there are many VBA 'best practice' tips to reduce this code. I would be grateful if you could pass on these tips along with a potential solution!