I have 3 option buttons that populate cell K5 with "ELEV2", "STA2" OR "GRADE"
Cells D8, D10, D12, H8 and H10 are user input that will constantly be changed by user
I need help getting it to auto update when the user changes any of D8, D10, D12, H8 or H10.
Also I would like to lock H10 in the Case of ELEV2, but when I insert Range("H10").Locked = True , i get an error
Any help would be great, I am a beginner!! (Excel 2007)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sta1 As Integer
Dim Elev1 As Integer
Dim Grade As Integer
Dim Sta2 As Integer
Dim Elev2 As Integer
'If Target.Address = "$K$5" Then
Set MyRange = Intersect(Target, Range("K5, D8, D10, D12, H8, H10"))
If Not MyRange Is Nothing Then
ActiveSheet.Unprotect ("Password")
Select Case Target.Value 'Target.Value OR MyRange?
Case "ELEV2" 'Calculates Elevation 2 if Elevation 2 Option Button is selected
Range("H8,D12").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("H10").Interior.Color = 16777062
Sta1 = Range("D8")
Elev1 = Range("D10")
Grade = Range("D12")
Sta2 = Range("H8")
'Elev2 = (Elev1 + (Sta2 - Sta1) * (Grade / 100))
Range("H10").Value = (Elev1 + (Sta2 - Sta1) * (Grade / 100))
Case "STA2" 'Calculates Station 2 if Station 2 Option Button is selected
Range("H10,D12").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("H8").Interior.Color = 16777062
Sta1 = Range("D8")
Elev1 = Range("D10")
Grade = Range("D12")
Elev2 = Range("H10")
'Sta2 = (Elev2 - Elev1) / (Grade / 100) + Sta1
Range("H8").Value = ((Elev2 - Elev1) / (Grade / 100) + Sta1)
Case "GRADE" 'Calculates Grade if Grade Option Button is selected
Range("H8,H10").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("D12").Interior.Color = 16777062
Sta1 = Range("D8")
Elev1 = Range("D10")
Sta2 = Range("H8")
Elev2 = Range("H10")
'Grade = (Elev2 - Elev1) / (Sta2 - Sta1) * 100
Range("D12").Value = (Elev2 - Elev1) / (Sta2 - Sta1) * 100
End Select
ActiveSheet.Protect ("Password")
End If
'End If
End Sub
Bookmarks