• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 243
  • Last Modified:

Created ranges and name them

Dear Experts:

this nice code, courtesy by rorya, performs the following task ...
(1) looking for the word 'Sales' in the current worksheet,
(2) if found, creates a table with rngFound.CurrentRegion
(3) assigns/applies names and stylesfor these ListObjects
(4) looping

I would like to have a second version of this code ...
... where the created ranges 'just' get named with the following naming convention: range1, range2, range3 and no 'ListObjects' are created.

I hope this is feasible.

Thank you very much in advance. Regards, Andreas

Sub CreateSalesTables()
   Dim rngFound As Range
   Dim strAddy As String
   Dim lngCounter As Long
   Set rngFound = ActiveSheet.UsedRange.Find(what:="Sales", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
   If Not rngFound Is Nothing Then
      lngCounter = 1
      strAddy = rngFound.Address
      Do
         CreateTable rngFound.CurrentRegion, "Table" & lngCounter
         lngCounter = lngCounter + 1
         Set rngFound = ActiveSheet.UsedRange.FindNext(rngFound)
      Loop While rngFound.Address <> strAddy
   End If
End Sub

Sub CreateTable(rng As Range, strName As String)
    With rng.Worksheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
      .Name = strName
        'No go in 2003
      .TableStyle = "TableStyleLight2"
   End With

End Sub

Open in new window

0
Andreas Hermle
Asked:
Andreas Hermle
1 Solution
 
Rory ArchibaldCommented:
As I said before:
Sub CreateSalesTables()
   Dim rngFound As Range
   Dim strAddy As String
   Dim lngCounter As Long
   Set rngFound = ActiveSheet.UsedRange.Find(what:="Sales", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
   If Not rngFound Is Nothing Then
      lngCounter = 1
      strAddy = rngFound.Address
      Do
         rngFound.CurrentRegion.Name =,"Range" & lngCounter
         lngCounter = lngCounter + 1
         Set rngFound = ActiveSheet.UsedRange.FindNext(rngFound)
      Loop While rngFound.Address <> strAddy
   End If
End Sub

Open in new window


:)
0
 
Andreas HermleTeam leaderAuthor Commented:
Rorya:
great. Thank you very much for your excellent and swift help.

Regards, Andreas
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now