I have an issue I can't solve with the existing Stackoverflow questions. I am trying to achieve the following:
Within active worksheet (if module, then with worksheet("data")) In the column "I", if an entry value is made = "Y" it needs to trigger the following.
At the stage of the macro below, I got object error so I cannot proceed with the Outlook steps. Thank you.
Private Sub Worksheet_change(ByVal target As Range)
Dim Col As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long
Col = "I"
StartRow = 1
BlankRows = 1
LastRow = Cells(Rows.Count, Col).End(xlUp).Row
Application.ScreenUpdating = False
With ActiveSheet
For R = LastRow To StartRow + 1 Step -1
If .Cells(R, Col) = "Y" Then
.Cells(R, Col).EntireRow.Insert Shift:=xlUp
End If
Next R
End With
Application.ScreenUpdating = True
End Sub
The worksheet_change() event has a parameter, called target. It is defined as a Range and represents the Range that triggered the event (meaning the Range that has changed).
By using this parameter you can easily distinguish between the Rows/Cells that have changed and the ones that stayed the same.
Option Explicit
Private Sub Worksheet_change(ByVal target As Range)
Dim i As Long
Const columnID As Long = 9
Dim targetCell As Range
Dim newRow As Range
Application.EnableEvents = False
On Error GoTo TearDown
For Each targetCell In target 'changed Range can be more than 1 Cell so this loops through that collection
With targetCell
If .Column <> columnID Then Exit For
If .Value = "Y" Then
With .EntireRow
.Insert Shift:=xlUp
.Copy
Set newRow = .Offset(-1)
newRow.PasteSpecial xlPasteValues
End With
newRow.Cells(1, columnID).Clear
End If
End With
Next targetCell
TearDown:
Application.EnableEvents = True
End Sub
This Sub will now create a newLine above the line that changed it's value in Column "I" to "Y" and copy the values into the new Line (and clear Column I)
The number Of times a newCell is inserted, or the function to change the Date in column A or the message box are all things you should be able to implement from here.
*The Application.EnableEvents = False is required (and if not highly advised) since you could otherwise run into an infinite loop, since the sub changes the sheet and is called when the sheet get's changed.
Edit: to insert more than 1 row (or basically doing the same thing 3 times) you can extract the logic that creates the new row and does all the changing into a sub/function, and call that 3 times
Option Explicit
Private Sub Worksheet_change(ByVal target As Range)
Dim i As Long
Dim targetCell As Range
Dim newRow As Range
Application.EnableEvents = False
On Error GoTo TearDown
For Each targetCell In target 'changed Range can be more than 1 Cell so this loops through that collection
With targetCell
If .Column <> columnID Then Exit For
If .Value = "Y" Then
Set newRow = getDuplicatedRow(targetCell.EntireRow)
Set newRow = getDuplicatedRow(newRow)
Set newRow = getDuplicatedRow(newRow)
End If
End With
Next targetCell
TearDown:
Application.EnableEvents = True
End Sub
Function getDuplicatedRow(targetRow As Range) As Range
Dim newRow As Range
With targetRow
.Insert Shift:=xlUp
.Copy
Set newRow = .Offset(-1)
newRow.PasteSpecial xlPasteValues
End With
newRow.Cells(1, columnID).Clear
newRow.Cells(1, 2).Value = newRow.Cells(1, 2).Value + 1
Set getDuplicatedRow = newRow
End Function
and Module1:
Option Explicit
Global Const columnID As Long = 9
'you can only declare Global consts in regular modules, so that's why this is here
'how/where you handle your columnID is up to you, just change it to fit your needs
This will create 3 new Rows ... each row being based on the row before it. So the first row you insert will be copied and changed from the row that changed. The 2nd row will get copied and changed from the 1st row and the 3rd row from the 2nd. (I have illustrated this in my code by having the 2nd column add 1 to the column it is copied from)