View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Frank Kabel Frank Kabel is offline
external usenet poster
 
Posts: 3,885
Default Add another range

Hi Pat
try the following (not fully tested and not beautiful..)
Frank

------

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const fixed_name1 = "lock_formula1"
Const fixed_name2 = "lock_formula2"
Const refer_str1 = "=Sheet1!$H$1:$H$800"
Const refer_str2 = "=Sheet1!$R$1:$R$800"
Dim rng As Range
Dim save_formula

If IsError(Evaluate(fixed_name1)) Then
ActiveWorkbook.Names.Add Name:=CStr(fixed_name1),
RefersTo:=CStr(refer_str1)
Else
If CStr(ActiveWorkbook.Names(CStr(fixed_name1)).Refer sTo) <
CStr(refer_str1) Then
On Error GoTo CleanUp
Application.EnableEvents = False
Set rng = Evaluate(fixed_name1)
save_formula = rng.Formula
rng.Value = ""
Set rng = Range(CStr(refer_str1))
rng.Formula = save_formula
ActiveWorkbook.Names(CStr(fixed_name1)).RefersTo =
CStr(refer_str1)
Else
'do nothing for this range
End If
End If

If IsError(Evaluate(fixed_name2)) Then
ActiveWorkbook.Names.Add Name:=CStr(fixed_name2),
RefersTo:=CStr(refer_str2)
Else
If CStr(ActiveWorkbook.Names(CStr(fixed_name2)).Refer sTo) <
CStr(refer_str2) Then
On Error GoTo CleanUp
Application.EnableEvents = False
Set rng = Evaluate(fixed_name2)
save_formula = rng.Formula
rng.Value = ""
Set rng = Range(CStr(refer_str2))
rng.Formula = save_formula
ActiveWorkbook.Names(CStr(fixed_name2)).RefersTo =
CStr(refer_str2)
Else
'do nothing for this range
End If
End If

CleanUp:
Application.EnableEvents = True
End Sub