Add another range

[Pat]

The following code was kindly provided to me:

Private Sub Worksheet_Change(ByVal Target As Range)
Const fixed_name = "lock_formula"
Const refer_str = "=Sheet1!$H$1:$H$800"
Dim rng As Range
Dim save_formula

If IsError(Evaluate(fixed_name)) Then
ActiveWorkbook.Names.Add Name:=CStr(fixed_name),
RefersTo:=CStr(refer_str)
Else
If CStr(ActiveWorkbook.Names(CStr(fixed_name)).RefersTo) <>
CStr(refer_str) Then
On Error GoTo CleanUp
Application.EnableEvents = False
Set rng = Evaluate(fixed_name)
save_formula = rng.Formula
rng.Value = ""
Set rng = Range(CStr(refer_str))
rng.Formula = save_formula
ActiveWorkbook.Names(CStr(fixed_name)).RefersTo =
CStr(refer_str)
Else
'do nothing
End If
End If

CleanUp:
Application.EnableEvents = True
End Sub


I now want to include another range within the code:

Const refer_str = "=Sheet1$R$1:$R$800"

can anyone help with this?

thanks
Pat

 

[Frank Kabel]

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)).RefersTo) <>
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)).RefersTo) <>
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

 

[Tom Ogilvy]

Frank made some assumptions on what you want to do - but unless he nailed
it, you would need to state what you mean by add a second range. You set a
defined name to your range, so adding a second name would mean you want to
then redefine that same named range to the second range? If not state what
you actually want to do. If you want to reuse the logic of your code, then
you need to move it to a subroutine or function and pass it the data you
want to work with.

 

[Frank Kabel]

Hi Tom
I had one advantage: I provided the original code to him
But you're right, the OP should state his intentions with more detail
Regards
Frank

 

[Frank Kabel]

Hi Pat
though this can also be achieved i'm wondering what is your final goal
with this. This kind of code and 'locking' columns/rows is not a
standard procedure for Excel. Why does anybody delete columns after
setting up the spreadsheet. IMO it would be better to create the
spreadsheet and protect everything.
Just curious as I had never the requirement to 'lock' columns this
way...

But to your question. Just add the following line
Range("A1").formula = "=IV1"
after
ActiveWorkbook.Names(CStr(fixed_name)).RefersTo = CStr(refer_str)

Frank

 

[Tom Ogilvy]

A1 should contain the formula

=Indirect("IV1")



You would have to use Frank's method to maintain the value in IV1.

 

[Pat]

Hello gentlemen

You are right I should have provided more details. This is borne out in that
the result I
was looking for is not what I expected. Let me explain with an example.

Let say columns A1 and IV1 are the cells locked.

Const refer_str1 = "=Sheet1!$A$1"
Const refer_str2 = "=Sheet1!$IV$1"

A1 has the formula =IV1
IV1 contains a value

Then delete column T (or any column)

IV1 still contains the same value
A1 formula now is =IU1

The question now is - how do you prevent A1 formula changing.

Pat

 

[Pat]

Hello gentlemen

To answer your question Frank
"Why does anybody delete columns after setting up the spreadsheet."

The last column IV in the spreadsheet I am currently working on must always
contain the formula
created for it. As the spreadsheet will be used regularly before it is
completely
set up, it will be in an evolvelouationary state for quite some time.

Hope that answers your question.


----------------------------------------------------------------------------
---

To Tom now. I used your formula as it will be easier for me to incorporate
it
into an existing formula.

Regards
Pat