How to run macro for each cell individually ?

[Ankush33]

Hello

I have a macro that will automatically run as i change the cell value from the drop down selection.
its working fine, but now i want to apply this to whole column. As well as it work only for each cell individually, like i change the value in B5 ,then only result changes in D5.

please help me for that.

i am sharing the macro code.


Module 1 :-

Sub risk()


If Range("c2").Value = Range("Paid") Then
Range("d2").Value = "=b2"


If Range("c2").Value = Range("Remaining") Then
Range("d2").Value = "enter amount"
End If

End Sub


and for running this automatically by selection drop down i use -

In Sheet1 :-


Sub Worksheet_change(ByVal target As Range)

If Not Intersect(target, Range("c2")) Is Nothing Then

Call risk

End If

End Sub


here is mini sheet-

paid.xlsm
	A	B	C	D
1			Drop-Down
2		500	Remaining	enter amount
3
4		300	Paid
5		600	Remaining
6
7
8
9
10
Risk

Cells with Data Validation
Cell	Allow	Criteria
C2:C7	List	Paid,Remaining

 

[Alex Blakenburg]

I am a little confused. Your post says

change the value in B5

But your change event is testing for a change in C2.

If Not Intersect(target, Range("c2")) Is Nothing Then

Are you wanting it to run when you make a change in B2, B3, B4 etc and having the code make the changes in C2/D2, C3/D3, C4/D4 etc ?

 

[Zot]

Perhaps something like this if I understood your question right.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngAction As Range

Set rngAction = Union(Range("C2"), Range("B5"))

If Not Intersect(Target, rngAction) Is Nothing Then
    Select Case Target.Address(0, 0)
        Case "C2"
            Call risk
        Case "B5"
            ' Another routine here
    End Select
End If

End Sub

 

[Ankush33]

I am a little confused. Your post says

But your change event is testing for a change in C2.

If Not Intersect(target, Range("c2")) Is Nothing Then

Are you wanting it to run when you make a change in B2, B3, B4 etc and having the code make the changes in C2/D2, C3/D3, C4/D4 etc ?

yes....
But also i want macro run for a single cell only.
like i select the "remaining" in c2, result in d2 will comes "enter value", so i enter a custom value their.
but next when i select "remaining" in c3, d3 will comes "enter value", but also it change the value in d2.
?

 

[Ankush33]

Perhaps something like this if I understood your question right.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngAction As Range

Set rngAction = Union(Range("C2"), Range("B5"))

If Not Intersect(Target, rngAction) Is Nothing Then
    Select Case Target.Address(0, 0)
        Case "C2"
            Call risk
        Case "B5"
            ' Another routine here
    End Select
End If

End Sub

B C D F
Total Price status Amount Remaing amount
1000 Paid 1000 0
2000 Remaining Enter Amount 0 / next i edit this 2000 Remaining 1500 500
3000 Remaining enter amount


here i show my requirement. if total amount is paid then "d1" = "b1"
next if total amount in not fully paid then i select Remaining then "d2" = "enter amount"
so i put the amount suppose "1500" manually , so in "F2" i get difference amount for paid "=b2-d2".

but again i select "Remaining " for next cell then "d2" and "d3" both changes to "Enter amount"

i want this macro to work for individually cell

 

[Ankush33]

Perhaps something like this if I understood your question right.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngAction As Range

Set rngAction = Union(Range("C2"), Range("B5"))

If Not Intersect(Target, rngAction) Is Nothing Then
    Select Case Target.Address(0, 0)
        Case "C2"
            Call risk
        Case "B5"
            ' Another routine here
    End Select
End If

End Sub

paid.xlsm
	B	C	D	E
1	Total Amount	Drop-Down	Paid Amount	Remaining Amount
2	500	Paid	500	0
3	5000	Remaining	enter amount	0
4	300	Remaining	enter amount	0
5	600	Remaining	enter amount	0
6				0
Risk

Cell Formulas
Range	Formula
D2	D2	=B2
E2:E6	E2	=IF(OR(D2="enter amount",D2=""),"0",B2-D2)

Cells with Data Validation
Cell	Allow	Criteria
C2:C6	List	Paid,Remaining

here i show my requirement. if total amount is paid then "d1" = "b1"
next if total amount in not fully paid then i select Remaining then "d2" = "enter amount"
so i put the amount suppose "3000" manually , so in "F2" i get difference amount for paid "=b2-d2".

but again i select "Remaining " for next cell then "d2" and "d3" both changes to "Enter amount"

i want this macro to work for individually cell

 

[Alex Blakenburg]

Try this:
In the worksheet module put this:

Sub Worksheet_change(ByVal target As Range)
    If Not Intersect(target, Columns("C")) Is Nothing Then
        Call risk(target, Me)    
    End If
End Sub

In module1 put this:

Sub risk(currentCell As Range, ws As Worksheet)

    Dim currRow As Long
    currRow = currentCell.Row
    
    With ws
        If .Range("C" & currRow).Value = "Paid" Then _
            .Range("D" & currRow).Value = "=b" & currRow
          
        If .Range("C" & currRow).Value = "Remaining" Then _
            .Range("D" & currRow).Value = "enter amount"
    End With

End Sub

 

[Ankush33]

Try this:
In the worksheet module put this:

Sub Worksheet_change(ByVal target As Range)
    If Not Intersect(target, Columns("C")) Is Nothing Then
        Call risk(target, Me)   
    End If
End Sub

In module1 put this:

Sub risk(currentCell As Range, ws As Worksheet)

    Dim currRow As Long
    currRow = currentCell.Row
   
    With ws
        If .Range("C" & currRow).Value = "Paid" Then _
            .Range("D" & currRow).Value = "=b" & currRow
         
        If .Range("C" & currRow).Value = "Remaining" Then _
            .Range("D" & currRow).Value = "enter amount"
    End With

End Sub

Thank you so much sir

it worked.

 

[Alex Blakenburg]

Thanks for letting us know. Glad we could help.