On 25 Feb., 16:19, Alan wrote:
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.- Zitierten Text ausblenden -

- Zitierten Text anzeigen -

Dear Allan,

as I already posted to Ron, his code works just fine. I re-tested it
several times on a clean worksheet and it worked.

Nevertheless your code works too. Thank you very much for your
professional support. I really appreciate it.

Regards, Andreas