Need to test if Worksheet Name Exists

[bconner]

I have a report and I want to parse the data into seperate Worksheets By Hospital Name. Since the Hospital Name can exist multiple times in the data I need to loop thru the worksheets before creating a new worksheet to make sure the name doesn't already exist.

I can't Sort the file to group all hospital names together it has to stay in the order it is in....

I am attaching some sample data

Below is the code I am trying to use to Loop thru the data and create one worksheet for each Hospital Name:

 
Dim rngstartP As Range
Dim rngendP As Range
Dim BExists As Boolean
 
 
BExists = False
For ct = 1 To Worksheets.Count
        If rngstartP.Value = Worksheets(ct).Name Then
            BExists = True
            Exit For
        End If
Next ct
        If BExists = False Then
 
For Each rngstartP In rngendP
        If rngstartP.Value <> rngstartP.Offset(-1, 0).Value Then
           Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = rngstartP.Offset(1, 0)
        End If
Next rngstartP
 
 
 
 
End If
End Sub

Any help is greatly appreciated

[Bob Phillips]

Untested

[vba]

Dim rngstartP As Range
Dim rngendP As Range
Dim arySheets As Variant


ReDim arySheets(1 To Worksheets.Count)
For ct = 1 To Worksheets.Count

arySheets(i) = Worksheets(i).Name
Next ct

For Each rngstartP In rngendP
If IsError(Application.Match(rngstartP.Value, arySheets, 0)) Then

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = rngstartP.Offset(1, 0).Value
ReDim Preserve arySheets(1 To UBound(arySheets) + 1)
arySheets(UBound(arySheets)) = rngstartP.Offset(1, 0).Value
End If
Next rngstartP
[/vba]

[bconner]

I tested the code and I get an 'Subscript Out of Range Error' and it highlights the following code arySheets(i) = Worksheets(i).Name

I am pretty new to VBA so I apologize......

[Bob Phillips]

Got my loop counters mixed

[vba]

ReDim arySheets(1 To Worksheets.Count)
For ct = 1 To Worksheets.Count

arySheets(ct) = Worksheets(ct).Name
Next ct

For Each rngstartP In rngendP
If IsError(Application.Match(rngstartP.Value, arySheets, 0)) Then

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = rngstartP.Offset(1, 0).Value
ReDim Preserve arySheets(1 To UBound(arySheets) + 1)
arySheets(UBound(arySheets)) = rngstartP.Offset(1, 0).Value
End If
Next rngstartP
[/vba]

[bconner]

Worked like a Charm! I appreciate your help!