Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' Disable events so don't retrigger worksheet_change event until it is done
Application.EnableEvents = False
' Check that only one cell at a time is altered
If Target.Rows.Count <> 1 Or Target.Columns.Count <> 1 Then
MsgBox ("Error - you must change only one cell at a time. Data may be corrupted")
Exit Sub
End If
' Check whether the altered cell is within input range
If Not WithinInputRange(Target) Then Exit Sub
' If get past above statement, then we are within the input range
' Check if the altered cell is in the English units Column
If Target.Column = Me.Range("EnglishColumn").Column Then
If Target.Offset(0, 1).Value = "inch" Then
Target.Offset(0, 2).Value = Target.Value * 2.54
' Note this handles any item in input range with units of inch - both length and radius
End If
If Target.Offset(0, 1).Value = "lbm/inch^3" Then
Target.Offset(0, 2).Value = Target.Value * 27.7
End If
End If
' Check if the altered cell is in the Metric units Column
If Target.Column = Me.Range("MetricColumn").Column Then
If Target.Offset(0, 1).Value = "cm" Then
Target.Offset(0, -2).Value = Target.Value / 2.54
End If
If Target.Offset(0, 1).Value = "g/cm^3" Then
Target.Offset(0, -2).Value = Target.Value / 27.7
End If
End If
' Note the code has made assumptions about the relative location of columns in the offset arguments
' i.e. assume four columns left to right:
' english values, english units, metric values, metric units
Application.EnableEvents = True
End Sub
Private Function WithinInputRange(mycell As Range)
' Test whether mycell is within the range identified by named range "inputrange"
Dim testcell As Range
WithinInputRange = False
For Each testcell In Me.Range("inputrange")
If testcell.Address = mycell.Address Then WithinInputRange = True
Next testcell
End Function