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



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

[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



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

[bconner]

Worked like a Charm! I appreciate your help!