How do I cross reference two cells in a single worksheet?

[drewan]

Hello, I want to link two cells (or better yet - two columns) together so that when one changes the other is updated and vice versa. Both are in the same worksheet.
I would like to do this so that the user could input a value in either cell and the other would be updated automatically.
For example, one column would hold the values in meters and the other in inches. A user inputs a value in either cell and the second one is updated accordingly. I hope I've made it clear about what my problem is
Currently I'm trying to use this code:

Private Sub Copy(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name = "DS" And _
Range("C2").Value <> DSC Then
Sheets("DS").Range("D2").Value = _
Sheets("DS").Range("C2").Value
DSC = Sheets("DS").Range("C2").Value
ElseIf ActiveSheet.Name = "DS" And _
Range("D2").Value <> DSD Then
Sheets("DS").Range("C2").Value = _
Sheets("DS").Range("D2").Value
DSD = Sheets("DS").Range("D2").Value
End If
End Sub

with Public DSC, DSD in Module1 but it doesn't work.

 

[GTO]

Maybe:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Count = 1 Then
        If Not Application.Intersect(Range("A:A"), Target) Is Nothing Then
            'A:A holds meters
            Target.Offset(, 1) = Target.Value2 * 39.370079
        ElseIf Not Application.Intersect(Range("B:B"), Target) Is Nothing Then
            Target.Offset(, -1) = Target.Value / 39.370079
        End If
    End If
End Sub

 

[JamesW]

Hi,

Try this in your sheet code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim inchVal As Double, lRow As Long
    
    inchVal = 39.3700787
    lRow = Range("A" & Rows.Count).End(xlUp).Row
    If Not Intersect(Target, Range("A2:A" & lRow)) Is Nothing Then
        Target.Offset(0, 1).Value = Target.Value * inchVal
    End If
End Sub

I've added the conversion from M to Inches.

 

[drewan]

Thank you for your quick responses
Unfortunatelly, neither of the codes seem to have any effect on the worksheet. The workbook is macro-enabled and I'm working with MS Excel 2007, if that makes it any clearer.

 

[GTO]

Hi there,

Sorry I did not mention. Both James and my code are worksheet events, thus the code must be in the sheet's module that it is to run against.

Mark

 

[drewan]

That did it, thank you
Here's how I tweaked your code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim toCi As Double, toMBq As Double, lRow As Long

toCi = 0.000027027
toMBq = 37000
lRow = Range("C" & Rows.Count).End(xlUp).Row
If Not Intersect(Target, Range("C2:C" & lRow)) Is Nothing Then
Target.Offset(0, 1).Value = Target.Value * toCi
End If
lRow = Range("D" & Rows.Count).End(xlUp).Row
If Not Intersect(Target, Range("D2:D" & lRow)) Is Nothing Then
Target.Offset(0, -1).Value = Target.Value * toMBq
End If
End Sub

Now there's another problem, though.
If I input 10 in column C, i get the expected 0.00027 in column D. However, the 10 gets immediately recalculated back in column C. I suppose I should add some sort of check for manual input, but I'm not really got at VB and don't have a clue on how to do it

 

[GTO]

Hi again,

Quickly read, but assuming I haven't glossed over something...

Try the code closer to what I offiered. The ElseIf prevents both from running. Also, I believe you'll want to check Target.Count, as if the user is clearing a bunch of cells, .Value can hiccup.

 

[drewan]

Hello again
I still haven't solved the problem of both fields being recalculated.
Now I'm working with this code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count = 1 Then
If Not Intersect(Target, Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)) Is Nothing Then
Target.Offset(, 1) = Target.Value2 * 0.000027027
ElseIf Not Intersect(Target, Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)) Is Nothing Then
Target.Offset(, -1) = Target.Value * 37000
End If
End If
End Sub

 

[Weaver]

right click the sheet tab and choose 'view code'

Paste in the following

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo traperror
    Application.EnableEvents = False
    Select Case Target.Column
        Case 1:
            Cells(Target.Row, 2) = Target.Value * 2.54
        Case 2:
            Cells(Target.Row, 1) = Target.Value / 2.54
    End Select
traperror:
    Application.EnableEvents = True
End Sub

Any values you type into column A will be turned from inches to centimeters in B and vice versa. Text should be ignored, so you can enter headers

HTH

 

[drewan]

That did the trick, thanks!