Worksheet_Change handling different actions for different columns of a worksheet not looping correctly - excel

Question

In The following worksheet macro, I am attempting to perform different actions, depending on the column selected. In 2 cases the action performed depends on the Column selected and the column value.
For example, if a name is entered in column A, the date is automatically entered in column B.
When a drop down value is entered in Column L, date is entered in Column M. If data in column L = "Fees Received" or "Policy No. Issued" data is copied to another worksheet and the date is entered in column m.
All individual components are working. However not all the time.
I need the macro to identify the column and perform the correct action such that I can move from column to column and the macro to constantly run in the background and working correctly for all selected columns.
Private Sub Worksheet_Change(ByVal Target As Range)
'Dim C As Range, V
Dim answer As Integer
Dim LRowCompleted As Integer
Application.EnableEvents = False
MsgBox "Target Column is " & Target.Column
MsgBox "Target Value is " & Target.Value
If Target.Column = 1 Then
GoTo AddEntryDate
End If
If Target.Column = 12 Then
GoTo AddWorkStatusDate
End If
If (Target.Column = 12 And Target.Value = "Fees Received") Then
GoTo FeesReceived
End If
If (Target.Column = 12 And Target.Value = "Policy No. Issued") Then
GoTo PolicyNoIssued
End If
Exit Sub
AddEntryDate:
'Update on 11/11/2019 -If data changes in column L Activity , insert
'today's date into column M - Date of Activity
Dim WorkRng As Range
Dim rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("A:A"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each rng In WorkRng
If Not VBA.IsEmpty(rng.Value) Then
rng.Offset(0, xOffsetColumn).Value = Now
rng.Offset(0, xOffsetColumn).NumberFormat = "dd/mm/yyyy"
rng.Offset(3, xOffsetColumn).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
Exit Sub
AddWorkStatusDate:
'Update on 11/11/2019 -If data changes in column L Activity , insert
'today's date into column M - Date of Activity
Dim WorkRng2 As Range
Dim rng2 As Range
Dim yOffsetColumn As Integer
Set WorkRng2 = Intersect(Application.ActiveSheet.Range("L:L"), Target)
yOffsetColumn = 1
If Not WorkRng2 Is Nothing Then
Application.EnableEvents = False
For Each rng2 In WorkRng2
If Not VBA.IsEmpty(rng2.Value) Then
rng2.Offset(0, yOffsetColumn).Value = Now
rng2.Offset(0, yOffsetColumn).NumberFormat = "dd/mm/yyyy"
Else
rng2.Offset(0, yOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
Exit Sub
PolicyNoIssued:
Sheets("Income").Select
LRowCompleted = Sheets("Income").Cells(Rows.Count, "A").End(xlUp).Row '
'Request confirmation from the user, in form of yes or no
answer = MsgBox("Do you want to copy this client to the Income Worksheet?", vbQuestion + vbYesNo)
If answer = vbYes Then
Range("A" & Target.Row & ":A" & Target.Row).Copy
Sheets("Income").Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.EnableEvents = True
Else
MsgBox "This client will not be copied to the Income Worksheet"
Application.EnableEvents = True
End If
Exit Sub
FeesReceived:
'Define last row on Income worksheet to know where to place the row of data
Sheets("Income").Select
LRowCompleted = Sheets("Income").Cells(Rows.Count, "A").End(xlUp).Row
'Request confirmation from the user, in form of yes or no
answer = MsgBox("Do you want to copy this client to the Income Worksheet?", vbQuestion + vbYesNo)
If answer = vbYes Then
Range("A" & Target.Row & ":A" & Target.Row).Copy
Sheets("Income").Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.EnableEvents = True
Else
MsgBox "This client will not be copied to the Income Worksheet"
Application.EnableEvents = True
End If
Application.EnableEvents = True
End Sub

Answer 1

From what I can see, you need to monitor only 2 columns. Rest of your requirements is just subsets of those requirements.
Your code can be re-written as below (UNTESTED) Let me know if you get any error? Also since you are working with Worksheet_Change, you may want to see THIS.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim aCell As Range
Dim wsInc As Worksheet
Dim lRow As Long
Dim ans As Variant
On Error GoTo Whoa
Application.EnableEvents = False
'~~> Check if the change happened in Col A
If Not Intersect(Target, Columns(1)) Is Nothing Then
For Each aCell In Target.Cells
With aCell
If Len(Trim(.Value)) = 0 Then
.Offset(, 1).ClearContents
Else
.Offset(, 1).NumberFormat = "dd/mm/yyyy"
.Offset(, 1).Value = Now
With .Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End With
Next
'~~> Check if the change happened in Col L
ElseIf Not Intersect(Target, Columns(12)) Is Nothing Then
Set wsInc = Sheets("Income")
lRow = wsInc.Range("A" & wsInc.Rows.Count).End(xlUp).Row + 1
For Each aCell In Target.Cells
With aCell
If Len(Trim(.Value)) = 0 Then
.Offset(, 1).ClearContents
Else
.Offset(, 1).NumberFormat = "dd/mm/yyyy"
.Offset(, 1).Value = Now
With .Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'~~> Check of the value is Fees Received, Policy No. Issued
If .Value = "Fees Received" Or .Value = "Policy No. Issued" Then
ans = MsgBox("Do you want to copy this client to the Income Worksheet?", vbQuestion + vbYesNo)
If ans = False Then Exit For
wsInc.Range("A" & lRow).Value = Range("A" & aCell.Row).Value
End If
End If
End With
Next
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub