On Feb 25, 2:56*pm, Alan wrote:
On Feb 25, 2:11*pm, Ron Rosenfeld wrote:





On Fri, 25 Feb 2011 05:07:54 -0800 (PST), AndreasHermle wrote:
Dear Experts:

I wonder whether the following is possible using VBA:

1. Search for the word 'Sales' on the current worksheet
2. If found then the following action has to be performed (This has
been recorded using the macro recorder)
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
3. The range has to be named 'range1'
4. The macro goes on searching for all instances of 'Sales', repeating
the named range creation as described under Point 2 and the 3
5. the range name's number is to be incremented by 1, i.e. range1,
range2, range3 etc.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

Perhaps something like below will get you started. *I may have missed some fine points.

The CurrentArea property of the Range object should work better for you than the cursor moves you recorded.

===============================
Option Explicit
Sub NameSales()
* * Dim c As Range
* * Dim firstAddress As String
* * Dim i As Long
i = 1
With Range("A1")
If .Value = "Sales" Then
* * .CurrentRegion.Name = "range" & i
* * firstAddress = .Address
* * i = i + 1
End If
End With

Set c = Cells.Find(What:="Sales", After:=Range("A1"), _
* * * * * * LookIn:=xlValues, lookat:=xlWhole, _
* * * * * * searchorder:=xlByColumns, _
* * * * * * searchdirection:=xlNext, _
* * * * * * MatchCase:=True)

* * Do While Not c Is Nothing And c.Address < firstAddress
* * * * c.CurrentRegion.Name = "range" & i
* * * * i = i + 1
* * * * If firstAddress = "" Then firstAddress = c.Address
* * * * Set c = Cells.FindNext(c)
* * Loop

End Sub
================================- Hide quoted text -

- Show quoted text -

I think Ron has missed your "Range(Selection,
Selection.End(xlToRight)).Select" and "Range(Selection,
Selection.End(xlDown)).Select" steps (these could be quite dangerous
because you could find your named ranges at the bottom of your
worksheet. However, in you insist, you may like to try ...

Option Explicit
Sub NameSales()
* * Dim c As Range
* * Dim firstAddress As String
* * Dim i As Long
* * Dim RngAddress as String
i = 1
With Range("A1")
If .Value = "Sales" Then
* * RngAddress = *_
Range(c.End(xlToRight).Address).End(xlDown).Addres s(ReferenceStyle:=xlR1C1)
* * *ActiveWorkbook.Names.Add Name:="Range" & i, _
* * * * *RefersToR1C1:="=" & ActiveSheet.Name & "!" & RngAddress
* * firstAddress = .Address
* * i = i + 1
End If
End With

Set c = Cells.Find(What:="Sales", After:=Range("A1"), _
* * * * * * LookIn:=xlValues, lookat:=xlWhole, _
* * * * * * searchorder:=xlByColumns, _
* * * * * * searchdirection:=xlNext, _
* * * * * * MatchCase:=True)

* * Do While Not c Is Nothing And c.Address < firstAddress
* * * * RngAddress = *_
Range(c.End(xlToRight).Address).End(xlDown).Addres s(ReferenceStyle:=xlR1C1)
* * *ActiveWorkbook.Names.Add Name:="Range" & i, _
* * * * *RefersToR1C1:="=" & ActiveSheet.Name & "!" & RngAddress
* * * * i = i + 1
* * * * If firstAddress = "" Then firstAddress = c.Address
* * * * Set c = Cells.FindNext(c)
* * Loop

End Sub- Hide quoted text -

- Show quoted text -

I'm sorry Ron but it sounded as though the OP was trying to get to the
end of the row, endof the column for the named range.

Either way Andreas, try ...

Option Explicit
Sub NameSales()
Dim c As Range
Dim firstAddress As String
Dim i As Long
i = 1
With Range("A1")
If .Value = "Sales" Then
.CurrentRegion.Name = "range" & i
firstAddress = .Address
i = i + 1
End If
End With


Set c = Cells.Find(What:="Sales", After:=Range("A1"), _
LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByColumns, _
searchdirection:=xlNext, _
MatchCase:=True)

On Error GoTo ERR1
Do While Not c Is Nothing And c.Address < firstAddress
c.CurrentRegion.Name = "range" & i
i = i + 1
If firstAddress = "" Then firstAddress = c.Address
Set c = Cells.FindNext(c)
Loop

ERR1:
Exit Sub

End Sub

Or add similar lines to the version of Ron's code that I modified.