Dynamic name

[rml]

Gary's student had given me a very simple yet productive reply to my previous
post DEFINE NAME. Now I need to expand this answer to a little more
dynamic....Based from my previous post, I need to have an automatic
generation of a list of all the reference cells in blank "Group_1", lets say
in Column IV. wherein each cell here will contain the cell reference (e.g.
A2, J4). Hope Gary's will reply...thanks...

 

[Gary''s Student]

In the last post we created the "GROUP_1" named range.

After the range has been created, add the line:

MsgBox (Range("GROUP_1").Address)

This lists the cells that comprise GROUP_1

 

[rml]

Gary..this is the module....
________
Sub main()
Dim r As Range
Dim rr As Range
Dim s As String
With ActiveWorkbook
c = .Names.Count
If c > 0 Then
For i = 1 To c
If .Names(i).Name = "GROUP_1" Then
..Names("GROUP_1").Delete
Exit For
End If
Next
End If
For Each r In Range("GROUP1")
If IsEmpty(r) Then
If rr Is Nothing Then
Set rr = r
Else
Set rr = Union(rr, r)
End If
End If
Next
s = rr.Address(ReferenceStyle:=xlR1C1)
MsgBox (s)
..Names.Add Name:="GROUP_1", RefersToR1C1:="=DYNANAME!" & s
End With
End Sub
_____

I dont know on which part i can insert the line.....
MsgBox (Range("GROUP_1").Address)
I hope also that we can generate cell refs. as requested by this thread..
thanks a lot

 

[Gary''s Student]

Hi:

Put this in the module. It also addresses the GROUP_2 issue:

Sub listum()
With ActiveWorkbook
If .Names.Count > 0 Then
For i = 1 To .Names.Count
MsgBox (i & " " & .Names(i).Name & " " & Range(.Names(i)).Address)
Next
End If
End With
End Sub

Sub main2()
Dim r As Range
Dim rr As Range
Dim s As String
With ActiveWorkbook
c = .Names.Count
If c > 1 Then
For i = c To 1 Step -1
If .Names(i).Name = "GROUP_1" Then
.Names("GROUP_1").Delete
End If
If .Names(i).Name = "GROUP_2" Then
.Names("GROUP_2").Delete
End If
Next
End If
For Each r In Range("GROUP1")
If IsEmpty(r) Then
If rr Is Nothing Then
Set rr = r
Else
Set rr = Union(rr, r)
End If
End If
Next
If rr Is Nothing Then
Else
s = rr.Address(ReferenceStyle:=xlR1C1)
.Names.Add Name:="GROUP_1", RefersToR1C1:="=Sheet1!" & s
End If

Set rr = Nothing
For Each r In Range("GROUP1")
If Not IsEmpty(r) Then
If rr Is Nothing Then
Set rr = r
Else
Set rr = Union(rr, r)
End If
End If
Next
If rr Is Nothing Then
Else
s = rr.Address(ReferenceStyle:=xlR1C1)
.Names.Add Name:="GROUP_2", RefersToR1C1:="=Sheet1!" & s
End If

Call listum

End With
End Sub


listum() handles the messaging. The routine will also work if you have no
blanks or all blanks.

 

[rml]

thanks Gary....I paste them all in the module....deleting the previous
lines...and when i change or blank some cells in GROUP1....the VBE window
pop-up with colored line....below...
...........
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("GROUP1")) Is Nothing Then
Else
Call main
End If
End Sub
..............
please take note that other worksheets contain other names....pls dont hang
up....thanks

 

[Gary''s Student]

My mistake, not your problem.

We changed the sub name from main to main2. Therefore the worksheet code
must become:


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("GROUP1")) Is Nothing Then
Else
Call main2
End If
End Sub

 

[rml]

I did change main into main2, as you told me....Very good...thanks...yet I am
quite bothered....there are consecutive pop ups and i have to hit "enter"s
and on the last pop-up...it says...
.........
Run-time error '1004':
Method 'Range of object '_Global failed
<buttons> End....Debug....Help
.........
when i hit End, pop up close and when i go to the sheet, click the GROUP
NAME - it dims the correct cells....

Does the pop-up has told it correctly as "GLOBAL failed" ? I hope there will
be no conflict with the rest of the worksheets and functions....please help
to clarify....I think we are almost through....
thanks again....

 

[Gary''s Student]

I can't replicate your error messages.

What was in your table when the error occurs??

 

[rml]

the pop-up error occurs after i enter a value on a blank cell.

 

[Gary''s Student]

I don't get a pop-up error. Let's re-paste the code from scratch:
Sub listum()
With ActiveWorkbook
If .Names.Count > 0 Then
For i = 1 To .Names.Count
MsgBox (i & " " & .Names(i).Name & " " & Range(.Names(i)).Address)
Next
End If
End With
End Sub
Sub main2()
Dim r As Range
Dim rr As Range
Dim s As String
With ActiveWorkbook
c = .Names.Count
If c > 1 Then
For i = c To 1 Step -1
If .Names(i).Name = "GROUP_1" Then
.Names("GROUP_1").Delete
End If
If .Names(i).Name = "GROUP_2" Then
.Names("GROUP_2").Delete
End If
Next
End If
For Each r In Range("GROUP1")
If IsEmpty(r) Then
If rr Is Nothing Then
Set rr = r
Else
Set rr = Union(rr, r)
End If
End If
Next
If rr Is Nothing Then
Else
s = rr.Address(ReferenceStyle:=xlR1C1)
.Names.Add Name:="GROUP_1", RefersToR1C1:="=Sheet1!" & s
End If

Set rr = Nothing
For Each r In Range("GROUP1")
If Not IsEmpty(r) Then
If rr Is Nothing Then
Set rr = r
Else
Set rr = Union(rr, r)
End If
End If
Next
If rr Is Nothing Then
Else
s = rr.Address(ReferenceStyle:=xlR1C1)
.Names.Add Name:="GROUP_2", RefersToR1C1:="=Sheet1!" & s
End If

Call listum

End With
End Sub

 

[rml]

Your right, i make it on a new workbook...and it work as u say....thanks a
lot....looking forward to get more help from you.

 

[Gary''s Student]

You are very welcome!!
--
Gary's Student

Your right, i make it on a new workbook...and it work as u say....thanks a
lot....looking forward to get more help from you.