optimize coding on named range

[Dantz]

is there a better way to do this?

Range("second_column").Select
Do While Not ActiveCell.Borders(xlEdgeBottom).Weight = xlMedium And Not
ActiveCell.Borders(xlEdgeBottom).LineStyle = xlContinuous
ActiveCell.Offset(1, 0).Select
Loop
Range(ActiveCell, Range("second_column")).Name= "second_column"

please help how to do this better..
in my named range I don't know how to get its column to check
for a specific cell outside(below) of the range

 

[Peter T]

One way -

Sub test()
Dim bGotCel As Boolean
Dim rwFirst As Long, rwLast As Long
Dim r As Long, c As Long
With Range("second_column")
rwFirst = .Row
c = .Column
End With

rwLast = Cells.SpecialCells(xlLastCell).Row

For r = rwFirst To rwLast
With Cells(r, c).Borders(xlEdgeBottom)
If .Weight = xlMedium And .LineStyle = xlContinuous Then
bGotCel = True
Exit For
End If
End With
Next

If bGotCel Then
Range(Cells(r, c), Range("second_column")).Name = "second_column"
Else
MsgBox "xlEdgeBottom xlMedium xlContinuous not found"
End If

Range("second_column").Select ' only if sure on active sheet

End Sub

Assumes "second_column" starts as a single named cell and hopefully a cell
with the border formats you are looking for exists somewhere below in same
column.

Regards

 

[Dantz]

thnks a lot...but what if i don't know the specific column...
let's say my "second_column" has a range from A5:A10,D510,F5:F10..

is there a way I can loop on its columns?

 

[Peter T]

You have substantially changed what you originally asked for but the below
should cater for your example even with specified border formats in
different rows.

I have to say I hesitate posting this. I think the idea is flawed, prone to
things going wrong. But as long as you are aware both of what you are doing
as regards the name and border formats and exactly what the code does.

If all you want to do is expand the named range down all you need to do is
ensure you insert new rows within the named range. The named range will
automatically expand by itself.

Sub test2()
Dim bGotCel As Boolean
Dim rwFirst As Long, rwLast As Long
Dim r As Long, c As Long
Dim ra As Range
Dim rng As Range
Dim rNew As Range

'uncomment next line after testing.
'Format cells below row10 with xlEdgeBottom with xlContinuous/xlMedium
Range("A5:A10,D510,F5:F10").Name = "second_column"

Set rng = Range("second_column")

For Each ra In rng.Areas

With ra
rwFirst = .Row
c = .Column
End With

rwLast = Cells.SpecialCells(xlLastCell).Row
bGotCel = False
For r = rwFirst To rwLast
With Cells(r, c).Borders(xlEdgeBottom)
If .Weight = xlMedium And .LineStyle = xlContinuous Then
bGotCel = True
Exit For
End If
End With
Next

If bGotCel Then
If rNew Is Nothing Then
Set rNew = Range(Cells(rwFirst, c), Cells(r, c))
Else
Set rNew = Union(rNew, Range(Cells(r, c), _
Range(Cells(rwFirst, c), Cells(r, c))))
End If

Else
MsgBox "xlEdgeBottom xlMedium xlContinuous not found"
Set rNew = Nothing
Exit For
End If
Next

If Not rNew Is Nothing Then
rNew.Name = "second_column"
rNew.Select
End If

End Sub

Regards,
Peter T

 

[Dantz]

thanks a lot..the first code that you gave worked out just fine
and the second one gave me another idea...

by the way...
this is out of the title but...is there a way how can i detect if the
user presses
Enter key in the cell? I want to save the input of the user after
pressing the
enter key...

 

[Peter T]

Not directly but look into the Worksheet_Change event, zillions of examples
in this ng

Rt-click a sheet tab, view code and paste following into the worksheet
module

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox Target(1).Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox Target(1).Value
End Sub

Regards,
Peter T

 

[Peter T]

instead of

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox Target(1).Value
End Sub

I meant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox Target.address
End Sub

but probably just the Worksheet_Change event is all you need.

Regards,
Peter T

 

[Dantz]

thanks a lot Peter..