On cell change do code

dado6612

Well-known Member
Joined
Dec 4, 2009
Messages
591
Hi all, Have a simple Table1 where in column C are Dates, in column D Status, and Column E Update.
What I wish for is that when a cell in Column E changes its value (it's data validation list) to do this:
Add value of cell to cell in column C (simple C.value=C.value+E.value*7)
Check if E.value was positive, if so
Find first "Priority" in D Status column, assign previous date value of changed cell
and at the end for any case
Set value of cell in E as blank

ex.
Initial
....A........B.......C.........D......E
Test1Test128.1
Test2Test228.2E2
Test3Test328.3
Test4Test428.4Priority
Test5Test528.5

<tbody>
</tbody>
Let say we change E2 to -2

....A........B.......C.........D......E
Test1Test128.1
Test2Test214.2
Test3Test328.3
Test4Test428.4Priority
Test5Test528.5

<tbody>
</tbody>
Date has updated by -2*7 days, now what if it was initially 2 in E2

....A........B.......C.........D....E
Test1Test128.1
Test4Test428.2Priority
Test2Test214.3
Test3Test328.3
Test5Test528.5

<tbody>
</tbody>
Test4 took a place of Test2
The rest got auto sorted by date

I thought it's gonna be easy, started to make a code, but just keep on getting error after error and crashes.
Any help?
Thanks
 
Last edited:

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
I am not sure this is going to work with the date format you show in your example. But it works with the regular date format. The code goes in your sheet code module and it will run when changes are made to the worksheet, but only executes on changes made in column E.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
Dim fn As Range, od As Date
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        od = Target.Offset(, -2).Value
        Target.Offset(, -2) = Target.Offset(, -2).Value + (Target.Value * 7)
        If Target.Value > 0 Then
            Set fn = Range("D:D").Find("Priority", , xlValues)
                If Not fn Is Nothing Then
                    fn.Offset(, -1) = od
                    fn.Offset(, 1) = ""
                End If
        End If
    End If
Application.EnableEvents = True
End Sub
 
Upvote 0
I am not sure this is going to work with the date format you show in your example. But it works with the regular date format. The code goes in your sheet code module and it will run when changes are made to the worksheet, but only executes on changes made in column E.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
Dim fn As Range, od As Date
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        od = Target.Offset(, -2).Value
        Target.Offset(, -2) = Target.Offset(, -2).Value + (Target.Value * 7)
        If Target.Value > 0 Then
            Set fn = Range("D:D").Find("Priority", , xlValues)
                If Not fn Is Nothing Then
                    fn.Offset(, -1) = od
                    fn.Offset(, 1) = ""
                End If
        End If
    End If
Application.EnableEvents = True
End Sub

It works brilliantly (I've put in Target.Value = "" to clear cell)
Thanks for your work and help, just a question if you could explain what was wrong with my try
Code:
Private Sub Worksheet_Change(ByVal Target As Range)Dim k As Long, status As Range, lr As Long
Dim cell_to_test As Range, cells_changed As Range, acell As Variant
Dim acell As String
Application.ScreenUpdating = False
acell = ActiveCell.Address
acellv = acell.Value
lr = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    Set status = Range("D2", "D" & lr)
k = Application.Match("Priority", status, 0) + 1
    Set cells_changed = Target(1, 1)
    Set cell_to_test = Range("e2", "e" & lr)
    If Not Intersect(cells_changed, cell_to_test) Is Nothing Then
ActiveCell.Offset(0, -2).Value = ActiveCell.Offset(0, -2).Value + Range(acell).Value * 7
If Range(acell).Value > 0 Then
Range("c" & k).Value = acellv
End If
End If
Range(acell).ClearContents
Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Actually an update, the code runs on any cell change on whole sheet.

Edit: Haha forget about it, my mistake, wrong placement of target clear, all works perfectly
Thanks again
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,877
Messages
6,122,051
Members
449,064
Latest member
scottdog129

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
Back
Top