Hello All.
I am new to this forum and hoping someone can help. I have exhausted all avenues trying to figure out an excel problem. I have a worksheet with a macro attached. The macro performs different actions depending on the data entered in specific columns. for example, is a name is entered in column A, date is automatically entered in column B. When a drop down value is entered in Column L, date is entered in Column L. If data in column L = "Fees Received" or "Policy No. Issued" data is copied to another worksheet. All individual components are working. However not all the time. I am new to VBA but believe I have the incorrect logic in my code. I would be very grateful for any help.
Code
- Private Sub
- Worksheet_Change(ByValTarget As Range)
- 'Dim C AsRange, V
- Dim answerAs Integer
- DimLRowCompleted 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 incolumn L Activity , insert
- 'today's date into column M - Date ofActivity
- 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 incolumn L Activity , insert
- 'today's date into column M - Date ofActivity
- 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, inform of yes or no
- answer = MsgBox("Do you want tocopy 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.PasteSpecialPaste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
- :=False, Transpose:=False
- Application.EnableEvents = True
- Else
- MsgBox "This client will notbe copied to the Income Worksheet"
- Application.EnableEvents = True
- End If
- Exit Sub
- FeesReceived:
- 'Define last row on Income worksheet toknow 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, inform of yes or no
- answer = MsgBox("Do you want tocopy 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.PasteSpecialPaste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
- :=False, Transpose:=False
- Application.EnableEvents = True
