Automatically change cell value based on other cell value

Hi
I Need Macro Automatically Past Yes Of Cell J To Cell K
If Cell J Change to yes

And When Change Cell J to Yes Past Cell D to cell L

TEST9.jpg

http://www.2shared.com/file/pBaU8RK-/book1.html

Hello etheer,

Why a Macro, if you could do it with formulas as per the attached WorkBook?

Also see the "Please consider" note at the bottom of this post.

Hi etheer,

But you do say in your first post;

And When Change Cell J to Yes Past Cell D to cell L

Maybe we have a misunderstanding here?

I have entered the formulas on your spreadsheet, See if it is acceptable now.

Thank you so much for your help Winon
but if change cell J no delete yes and number from cell K and L
i need when past yes and number in cell K and L do not delete

i get this macro

Private Sub Worksheet_Change(ByVal Target As Range)
' Code goes in the Worksheet specific module
Dim rng As Range
' Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3")
Set rng = Target.Parent.Range("J:J")
' Only look at single cell changes
If Target.Count > 1 Then Exit Sub
' Only look at that range
If Intersect(Target, rng) Is Nothing Then Exit Sub
' Action if Condition(s) are met (do your thing here...)
If UCase(Target.Value) = "Yes" Then
With Target
.Value = ""
.Offset(, 1).Value = "Yes"
Cells(Target.Row, "L").Value = Cells(Target.Row, "D").Value

End With
End If
End Sub

maybe you can edit it for work

Hi etheer,

O.K. Let us try this one. It is still using formulas, but retain the values as long as the Cell/s in Column D has some data.

If you prefer the alternative code then copy this Code over mine.

Just remember that with any one of the two solutions you have now, the code will only work in the Row where you change any cell in Column D.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
    If Not Intersect(Target, Range("D:D")) Is Nothing Then
        If Target.Offset(0, 6).Value <> "" Then
            Target.Offset(0, 7) = Target.Offset(0, 6)
            Target.Offset(0, 8) = Target
        End If
    End If
    Application.ScreenUpdating = True


End Sub

Have you tried the WorkBook in Post no. 9? Or the code in Post no. 10? If you tell us what you don't like about it, then maybe someone help you.

If you like that Code, then based on the Sample WorkBook in Post Number 9, use it like this:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target, Range("H:F")) Is Nothing Then
        On Error Resume Next
For Each c In Range("J7:J" & Cells(Rows.Count, "J").End(xlUp).Row)
        If c = "Yes" Then
            With c
                .Offset(, 1).Value = "Yes"
                .Offset(, 2).Value = .Offset(, -6).Value
            End With
        End If
    Next c
    End If

End Sub

Hope that helps.

Hello etheer,

You can change this line:

If Not Intersect(Target, Range("M:N:O:P")) Is Nothing Then

to

If Not Intersect(Target, Range("M:P")) Is Nothing Then

or to any other Range which you would like the Code to respond to, when you change any Data.

Your Formula in Column J has no effect on the "Intersect Target Range".

No it is not Impossible,

What do you want to delete? Make sample and show me.

Hello etheer,

Use this Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target, Range("F:H,M:P")) Is Nothing Then
        On Error Resume Next
For Each c In Range("J7:J" & Cells(Rows.Count, "J").End(xlUp).Row)
        If c = "Yes" Then
            With c
                .Offset(, 1).Value = "Yes"
                .Offset(, 2).Value = .Offset(, -6).Value
            End With
        End If
    Next c
    End If
End Sub

Also see "Please consider" at bottom of this post.

Then try it like this:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range

Application.EnableEvents = False
        On Error Resume Next
For Each c In Range("J7:J" & Cells(Rows.Count, "J").End(xlUp).Row)
        If c = "Yes" Then
            With c
                .Offset(, 1).Value = "Yes"
                .Offset(, 2).Value = .Offset(, -6).Value
            End With
        End If
    Next c
Application.EnableEvents = True
End Sub

Hello etheer,

Did you try the Code as per my last post?

I edit code to

Private Sub Worksheet_Calculate()
Dim c As Range
Application.EnableEvents = False
        On Error Resume Next
For Each c In Range("J7:J" & Cells(Rows.Count, "J").End(xlUp).Row)
        If c = "Yes" Then
            With c
                .Offset(, 1).Value = "Yes"
                .Offset(, 2).Value = .Offset(, -6).Value

            End With
        End If
    Next c
Application.EnableEvents = True
End Sub

work code 100% i have only one problem

when change any cell to #N/A code work crazy and past yes and number in all cells
how edit code not work if cells #N/A

Hi etheer,

Sorry, but I was away on renovating a house. Please try this formula in Column J with my sample code as per Post No. 28.

=IF(ISNA(AND(M7>=50%,N7>50%,O7>0%,P7>-30%,F7>0.2,X7<10%,Y7<10%)=TRUE),"",IF(AND(M7>=50%,N7>50%,O7>0%,P7>-30%,F7>0.2,X7<10%,Y7<10%)=TRUE,"Yes","No"))

I was thinking about the calculate aspect as well.

So try this:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range

Application.Calculation = xlCalculationManual
Application.EnableEvents = False
        On Error Resume Next
For Each c In Range("J7:J" & Cells(Rows.Count, "J").End(xlUp).Row)
        If c = "Yes" Then
            With c
                .Offset(, 1).Value = "Yes"
                .Offset(, 2).Value = .Offset(, -6).Value
            End With
        End If
    Next c
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub

Hello etheer,

Have you changed your Workbook layout?

I am totally confused with you referencing Column I which is Empty, and where does Column "AD" come from now, or do you actually mean Columns A & D?

Maybe it would be better if you upload your "New" sample WorkBook again so that we can have a look at it for you.