Add a new named range each time a cell changes

[Leonvl]

When a cell in the range A1:A100 is changed (added), I want to define a named range that referring to the two cells to the right. The name of the range can be the value of the target cell. I tried the below code but it doesnt work for some reason...

Private Sub Worksheet_Change(ByVal Target As Range)

Dim NamedRange As Range
Dim RangeName As String


If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
    Set NamedRange = Worksheets("Blad1").Range(Target.Offset(, 1), Target.Offset(, 2))
    RangeName = Target.Value
    Target.Names.Add Name:=RangeName, RefersTo:=NamedRange
End If
End Sub

 

[My Aswer Is This]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 6/11/18 7:10 PM EDT
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Target.Offset(, 1).Resize(, 2).Name = Target.Value
End If
End Sub

 

[Leonvl]

Thanks...! That does the job!

And so a new issue came up... If the target value contains spaces it needs to be trimmed. But "Trim(Target.Value)" seems not acceptable

Private Sub Worksheet_Change(ByVal Target As Range)

Dim NamedRange As Range
Dim RangeName As String


If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Target.Offset(, 1).Resize(, 2).Name = Trim(Target.Value)
End If


If Not Intersect(Target, Range("E1:E100")) Is Nothing Then
    Target.Offset(, 1) = ""
End If


End Sub

 

[My Aswer Is This]

So what are you doing entering some value like "My Dog is Black"

Give me some example of a value you want trimmed.

 

[My Aswer Is This]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 6/11/18 9:10 PM EDT
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
ans = Trim(Target.Value)
Target.Offset(, 1).Resize(, 2).Name = ans
End If
End Sub

 

[Leonvl]

No doest work
To illustrate what I am planning to do I am attaching the files

Initial file: https://redept.box.com/s/l60jljt2c1atlu0cteefcjdjlccu55hw
New file: https://redept.box.com/s/9alw6k2m3zzg0rk3cs1n3qom9509ta8q

 

[My Aswer Is This]

I never click on links or open files.
You need to explain what it does not do.
I asked this question which you did not answer:

So what are you doing entering some value like "My Dog is Black"

Give me some example of a value you want trimmed.​

 

[Leonvl]

"My dog is black" is a good example...

 

[Leonvl]

I got it figured!

Private Sub Worksheet_Change(ByVal Target As Range)


Dim NamedRange As Range
Dim RangeName As String
Dim ans As String


If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
ans = Replace(Target.Value, " ", "")
Target.Offset(, 1).Resize(, 2).Name = ans
End If


If Not Intersect(Target, Range("E1:E100")) Is Nothing Then
    Target.Offset(, 1) = ""
End If


End Sub

 

[My Aswer Is This]

Glad to see you have it working. I was just about ready to send you that same answer.
Was not sure how you would want to replace the spaces. With nothing or a underline.