How do I combine the following Private Sub Worksheet Changes?

[corey510]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("E:F")) Is Nothing Then Exit Sub

Application.EnableEvents = False 'Prevent infinite looping

If Target.Column = 5 Then
'User has changed something in column A:
Target.Offset(0, 1).Value = Round(Target / Range("H1").Value, 5)
Else
'User has changed something in column B:
Target.Offset(0, -1).Value = Round(Target * Range("H1").Value, 5)
End If

Application.EnableEvents = True

End Sub




and




Private Sub Worksheet_change(ByVal Target As Range)
Dim A As Range, B As Range, Inte As Range, RR As Range
Set A = Range("A3:A1002")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each RR In Inte
If RR.Value > 0 Then
RR.Offset(0, 1).Value = Date
Else
RR.Offset(0, 1).Value = ""
End If
Next RR
Application.EnableEvents = True
End Sub

 

[JLGWhiz]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Dim rng As Range, rr As Range
Set rng = Union(Range("A:A"), Range("E:F"))
Application.EnableEvents = False
    If Not Intersect(rng, Target) Is Nothing Then
        If Target.Column = 5 Then
            Target.Offset(0, -1).Value = Round(Target / Range("H1").Value, 5)
        ElseIf Target.Column = 6 Then
            Target.Offset(0, -1).Value = Round(Target * Range("h1").Value, 5)
        End If
        If Not Intersect(Range("A:A"), Target) Is Nothing Then
            For Each rr In Range("A3", Cells(Rows.Count, 1).End(xlUp))
                If rr.Value > 0 Then
                    rr.Offset(, 1).Value = Date
                Else
                    rr.Offset(, 1).Value = ""
                End If
            Next
        End If
    End If
Application.EnableEvents = True
End Sub

 

[corey510]

Thank you for the code. Regarding populating the date in column "B" when a value was entered in Colum"A", my old code would remove the date in column "B" when I deleted values in Colum "A" ( row by row). That feature is not working now. I also noticed I cannot get the code to run when copying and pasting values in the appropriate cells. Here is my old code which worked well:

I was then trying to create an active currency conversion calculator in my sheet. Currenty the user must enter a cost manually in columns "E" or "F". If USD teh user would enter the value in Column"E" . the value will be then be duplicated in column "V" so that other cells in that row of the sheet will calculate accordingly. If a user entered a value in column "F" ( Euros), the value would be duplicated in column "U" and would then be converted to USD in column "V" using the conversion rate in cell $U$1.

I wanted to eliminate the redundant cells. When the user enters a value in USD in a cell in column"E", the adjacent cell in Column"F" will automatically populate the currency conversion to EUROs and vise versa. If I enter or change the value in a cell in column "F" it will adjust or generate the appropriate conversion back to USD in the adjacent cell in Column "E". I should be able to enter a value or paste a value in either cell. If the value is cleared in either cell, the adjacent cell should also clear.

My sheet looks like this.