Tom Ogilvys Code

[Todd Huttenstine]

Hey Tom,

Its supposed to be set to A5:A53. Below is the code I am
currently using:

Private Sub CommandButton2_Click()

Dim rng As Range, rng1 As Range
Dim cell As Range, cell1 As Range
Dim rngStat As Range
Dim res As Variant

With Worksheets("Team Data")
Set rng = .Range("A5:A53")
Set rngStat = .Range("B4:U4")
End With

With Worksheets("Template")
Set rng1 = .Range("A5:A16")
End With

For Each cell In rng
For Each cell1 In rng1
res = Application.Match(cell1, rngStat, 0)
If Not IsError(res) Then
cell1.Offset(0, 1).Value = rngStat(cell.Row - 3,
res).Value
End If
Next
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(cell.Value).Delete
Application.DisplayAlerts = True
On Error GoTo 0
rng1.Parent.Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.name = cell.Value
rng1.Offset(0, 1).ClearContents
Next
End Sub

heres the problem, It works like I need. The only thing
it does wrong is after it creates the last sheet based
on the last persons name in range A5:A53, it creates
another sheet called Template(2) and then I get a runtime
error. I click Debug and then it brings up the screen
with the 2nd to the last line of the code highlighted(that
is ActiveSheet.name = cell.Value. This line is in
yellow. What I would like is that when the code sees
there are no more names in Range A5:A53, the code quits
without error and does not create a page at the end called
Template(2).

Thank you

Todd Huttenstine

 

[Tom Ogilvy]

I couldn't reproduce the problem. I had names in A5:A53 and it worked fine.

Nonetheless, I have put in some code that exits if it hits a blank cell in
A5:A53:

Public Sub CommandButton2_Click()

Dim rng As Range, rng1 As Range
Dim cell As Range, cell1 As Range
Dim rngStat As Range
Dim res As Variant

With Worksheets("Team Data")
Set rng = .Range("A5:A53")
Set rngStat = .Range("B4:U4")
End With

With Worksheets("Template")
Set rng1 = .Range("A5:A16")
End With

For Each cell In rng
If IsEmpty(cell) Then Exit Sub
For Each cell1 In rng1
res = Application.Match(cell1, rngStat, 0)
If Not IsError(res) Then
cell1.Offset(0, 1).Value = rngStat(cell.Row - 3, _
res).Value
End If
Next
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(cell.Value).Delete
Application.DisplayAlerts = True
On Error GoTo 0
rng1.Parent.Copy after:=Worksheets(Worksheets.Count)
On Error Resume Next
ActiveSheet.Name = cell.Value
If Err <> 0 Then
MsgBox "=>" & cell.Value & "<= is an illegal name"
Err.Clear
End If
On Error GoTo 0
rng1.Offset(0, 1).ClearContents
Next
End Sub

 

[Kevin Beckham]

Todd

After the line
For Each cell In rng
insert the following line
IF cell = "" then Exit For
This will stop the code running as soon as an empty cell
is reached

Kevin Beckham

 

[Todd Huttenstine]

Thank you both very much.