Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 237
Default Tom Ogilvys Code

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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 27,285
Default Tom Ogilvys Code

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


--
Regards,
Tom Ogilvy


Todd Huttenstine wrote in message
...
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



  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 78
Default Tom Ogilvys Code

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

-----Original Message-----
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
.

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 237
Default Tom Ogilvys Code

Thank you both very much.


-----Original Message-----
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
.

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
split post code (zip code) out of cell that includes full address Concord Excel Discussion (Misc queries) 4 October 15th 09 06:59 PM
Code to conditional format all black after date specified in code? wx4usa Excel Discussion (Misc queries) 3 December 26th 08 07:06 PM
Drop Down/List w/Code and Definition, only code entered when selec Spiritdancer Excel Worksheet Functions 2 November 2nd 07 03:57 AM
Convert a Number Code to a Text Code Traye Excel Discussion (Misc queries) 3 April 6th 07 09:54 PM
copying vba code to a standard code module 1vagrowr Excel Discussion (Misc queries) 2 November 23rd 05 04:00 PM


All times are GMT +1. The time now is 11:36 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"