[lnkForumImage]
TotalShareware - Download Free Software

Confronta i prezzi di migliaia di prodotti.
Asp Forum
 Home | Login | Register | Search 


 

Forums >

microsoft.public.excel.programming

Error Trap Via Message

Ardy

12/19/2006 5:19:00 PM

Hello All:
I have this code that creates tabs from a list, my problem is that I
want to add to it, so it would prevent creating tab if the name already
exist and give a message, can anybody help me
---------------------------------------------------------
Private Sub CommandButton3_Click()
' Declair Variables
Dim iLastRow As Long, i As Long, sh As Worksheet, LastCell As Range
Dim Rng As Range, cell As Range, WS As Worksheet

' Start Create Student Tab From List in Column A Starting A2
With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1
.Hyperlinks.Add Anchor:=Cells(i, "A"), _
Address:="", _
SubAddress:="'" & Cells(i, "A").Value &
"'!A1", _
TextToDisplay:=Cells(i, "A").Value
Next i
End With
'End Create Tab

' Start Creating Link From The List in Column A
' to The Student Tabs Starting FromCell A2
Set WS = ActiveSheet
Set LastCell = WS.Cells(Rows.Count, "A").End(xlUp)
Set Rng = WS.Range("A2", LastCell)

For Each cell In Rng
If Not IsEmpty(cell) Then
Sheets("Template").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = cell.Value
End If
Next
' End Creating Link

' Start Returning to Roster Tab
MakeVisible
Sheets("Template").Visible = False
Sheets("Template").Move Before:=Sheets(2)
Sheets("Roster").Select
Range("D2").Select
' Start Inserting formula for Transfering data to Roster
' module driven code
InsertInfoTransferFormula
CopyFormula
' End Inserting Formula For Transfering data to Roster
' Landing on Cell
Range("C1").Select
End Sub
----------------------------------------------------------------

4 Answers

Dave Peterson

12/19/2006 6:01:00 PM

0

One way...

dim testWks as worksheet
.....

For Each cell In Rng
If Not IsEmpty(cell) Then
set testwks = nothing
on error resume next
set testwks = worksheets(cell.value)
on error goto 0
if testwks is nothing then
'it doesn't exist
Sheets("Template").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = cell.Value
else
'already exists
end if
End If
Next

Ardy wrote:
>
> Hello All:
> I have this code that creates tabs from a list, my problem is that I
> want to add to it, so it would prevent creating tab if the name already
> exist and give a message, can anybody help me
> ---------------------------------------------------------
> Private Sub CommandButton3_Click()
> ' Declair Variables
> Dim iLastRow As Long, i As Long, sh As Worksheet, LastCell As Range
> Dim Rng As Range, cell As Range, WS As Worksheet
>
> ' Start Create Student Tab From List in Column A Starting A2
> With ActiveSheet
>
> iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
> For i = iLastRow To 2 Step -1
> .Hyperlinks.Add Anchor:=Cells(i, "A"), _
> Address:="", _
> SubAddress:="'" & Cells(i, "A").Value &
> "'!A1", _
> TextToDisplay:=Cells(i, "A").Value
> Next i
> End With
> 'End Create Tab
>
> ' Start Creating Link From The List in Column A
> ' to The Student Tabs Starting FromCell A2
> Set WS = ActiveSheet
> Set LastCell = WS.Cells(Rows.Count, "A").End(xlUp)
> Set Rng = WS.Range("A2", LastCell)
>
> For Each cell In Rng
> If Not IsEmpty(cell) Then
> Sheets("Template").Copy after:=Worksheets(Worksheets.Count)
> ActiveSheet.Name = cell.Value
> End If
> Next
> ' End Creating Link
>
> ' Start Returning to Roster Tab
> MakeVisible
> Sheets("Template").Visible = False
> Sheets("Template").Move Before:=Sheets(2)
> Sheets("Roster").Select
> Range("D2").Select
> ' Start Inserting formula for Transfering data to Roster
> ' module driven code
> InsertInfoTransferFormula
> CopyFormula
> ' End Inserting Formula For Transfering data to Roster
> ' Landing on Cell
> Range("C1").Select
> End Sub
> ----------------------------------------------------------------

--

Dave Peterson

Ardy

12/19/2006 9:11:00 PM

0

Thank You,
I added your suggestion to the code works fine, Added the msgBox to
inform, one thing I was wondering how I would bring in the name of the
duplicate name in the message.
----------------------------------------------------
For Each cell In Rng
If Not IsEmpty(cell) Then
Set ExistWks = Nothing
On Error Resume Next
Set ExistWks = Worksheets(cell.Value)
On Error GoTo 0
If ExistWks Is Nothing Then
'it doesn't exist
Sheets("Template").Copy
after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = cell.Value
Else
MsgBox "Name Already Exist"
End If
End If
Next
--------------------------------------------------------
Dave Peterson wrote:
> One way...
>
> dim testWks as worksheet
> ....
>
> For Each cell In Rng
> If Not IsEmpty(cell) Then
> set testwks = nothing
> on error resume next
> set testwks = worksheets(cell.value)
> on error goto 0
> if testwks is nothing then
> 'it doesn't exist
> Sheets("Template").Copy after:=Worksheets(Worksheets.Count)
> ActiveSheet.Name = cell.Value
> else
> 'already exists
> end if
> End If
> Next
>
> Ardy wrote:
> >
> > Hello All:
> > I have this code that creates tabs from a list, my problem is that I
> > want to add to it, so it would prevent creating tab if the name already
> > exist and give a message, can anybody help me
> > ---------------------------------------------------------
> > Private Sub CommandButton3_Click()
> > ' Declair Variables
> > Dim iLastRow As Long, i As Long, sh As Worksheet, LastCell As Range
> > Dim Rng As Range, cell As Range, WS As Worksheet
> >
> > ' Start Create Student Tab From List in Column A Starting A2
> > With ActiveSheet
> >
> > iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
> > For i = iLastRow To 2 Step -1
> > .Hyperlinks.Add Anchor:=Cells(i, "A"), _
> > Address:="", _
> > SubAddress:="'" & Cells(i, "A").Value &
> > "'!A1", _
> > TextToDisplay:=Cells(i, "A").Value
> > Next i
> > End With
> > 'End Create Tab
> >
> > ' Start Creating Link From The List in Column A
> > ' to The Student Tabs Starting FromCell A2
> > Set WS = ActiveSheet
> > Set LastCell = WS.Cells(Rows.Count, "A").End(xlUp)
> > Set Rng = WS.Range("A2", LastCell)
> >
> > For Each cell In Rng
> > If Not IsEmpty(cell) Then
> > Sheets("Template").Copy after:=Worksheets(Worksheets.Count)
> > ActiveSheet.Name = cell.Value
> > End If
> > Next
> > ' End Creating Link
> >
> > ' Start Returning to Roster Tab
> > MakeVisible
> > Sheets("Template").Visible = False
> > Sheets("Template").Move Before:=Sheets(2)
> > Sheets("Roster").Select
> > Range("D2").Select
> > ' Start Inserting formula for Transfering data to Roster
> > ' module driven code
> > InsertInfoTransferFormula
> > CopyFormula
> > ' End Inserting Formula For Transfering data to Roster
> > ' Landing on Cell
> > Range("C1").Select
> > End Sub
> > ----------------------------------------------------------------
>
> --
>
> Dave Peterson

Dave Peterson

12/19/2006 11:10:00 PM

0

MsgBox "This name: " & cell.value & " Already Exists"


Ardy wrote:
>
> Thank You,
> I added your suggestion to the code works fine, Added the msgBox to
> inform, one thing I was wondering how I would bring in the name of the
> duplicate name in the message.
> ----------------------------------------------------
> For Each cell In Rng
> If Not IsEmpty(cell) Then
> Set ExistWks = Nothing
> On Error Resume Next
> Set ExistWks = Worksheets(cell.Value)
> On Error GoTo 0
> If ExistWks Is Nothing Then
> 'it doesn't exist
> Sheets("Template").Copy
> after:=Worksheets(Worksheets.Count)
> ActiveSheet.Name = cell.Value
> Else
> MsgBox "Name Already Exist"
> End If
> End If
> Next
> --------------------------------------------------------
> Dave Peterson wrote:
> > One way...
> >
> > dim testWks as worksheet
> > ....
> >
> > For Each cell In Rng
> > If Not IsEmpty(cell) Then
> > set testwks = nothing
> > on error resume next
> > set testwks = worksheets(cell.value)
> > on error goto 0
> > if testwks is nothing then
> > 'it doesn't exist
> > Sheets("Template").Copy after:=Worksheets(Worksheets.Count)
> > ActiveSheet.Name = cell.Value
> > else
> > 'already exists
> > end if
> > End If
> > Next
> >
> > Ardy wrote:
> > >
> > > Hello All:
> > > I have this code that creates tabs from a list, my problem is that I
> > > want to add to it, so it would prevent creating tab if the name already
> > > exist and give a message, can anybody help me
> > > ---------------------------------------------------------
> > > Private Sub CommandButton3_Click()
> > > ' Declair Variables
> > > Dim iLastRow As Long, i As Long, sh As Worksheet, LastCell As Range
> > > Dim Rng As Range, cell As Range, WS As Worksheet
> > >
> > > ' Start Create Student Tab From List in Column A Starting A2
> > > With ActiveSheet
> > >
> > > iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
> > > For i = iLastRow To 2 Step -1
> > > .Hyperlinks.Add Anchor:=Cells(i, "A"), _
> > > Address:="", _
> > > SubAddress:="'" & Cells(i, "A").Value &
> > > "'!A1", _
> > > TextToDisplay:=Cells(i, "A").Value
> > > Next i
> > > End With
> > > 'End Create Tab
> > >
> > > ' Start Creating Link From The List in Column A
> > > ' to The Student Tabs Starting FromCell A2
> > > Set WS = ActiveSheet
> > > Set LastCell = WS.Cells(Rows.Count, "A").End(xlUp)
> > > Set Rng = WS.Range("A2", LastCell)
> > >
> > > For Each cell In Rng
> > > If Not IsEmpty(cell) Then
> > > Sheets("Template").Copy after:=Worksheets(Worksheets.Count)
> > > ActiveSheet.Name = cell.Value
> > > End If
> > > Next
> > > ' End Creating Link
> > >
> > > ' Start Returning to Roster Tab
> > > MakeVisible
> > > Sheets("Template").Visible = False
> > > Sheets("Template").Move Before:=Sheets(2)
> > > Sheets("Roster").Select
> > > Range("D2").Select
> > > ' Start Inserting formula for Transfering data to Roster
> > > ' module driven code
> > > InsertInfoTransferFormula
> > > CopyFormula
> > > ' End Inserting Formula For Transfering data to Roster
> > > ' Landing on Cell
> > > Range("C1").Select
> > > End Sub
> > > ----------------------------------------------------------------
> >
> > --
> >
> > Dave Peterson

--

Dave Peterson

Ardy

12/19/2006 11:41:00 PM

0

Thanks.........
Works Great
Dave Peterson wrote:
> MsgBox "This name: " & cell.value & " Already Exists"
>
>
> Ardy wrote:
> >
> > Thank You,
> > I added your suggestion to the code works fine, Added the msgBox to
> > inform, one thing I was wondering how I would bring in the name of the
> > duplicate name in the message.
> > ----------------------------------------------------
> > For Each cell In Rng
> > If Not IsEmpty(cell) Then
> > Set ExistWks = Nothing
> > On Error Resume Next
> > Set ExistWks = Worksheets(cell.Value)
> > On Error GoTo 0
> > If ExistWks Is Nothing Then
> > 'it doesn't exist
> > Sheets("Template").Copy
> > after:=Worksheets(Worksheets.Count)
> > ActiveSheet.Name = cell.Value
> > Else
> > MsgBox "Name Already Exist"
> > End If
> > End If
> > Next
> > --------------------------------------------------------
> > Dave Peterson wrote:
> > > One way...
> > >
> > > dim testWks as worksheet
> > > ....
> > >
> > > For Each cell In Rng
> > > If Not IsEmpty(cell) Then
> > > set testwks = nothing
> > > on error resume next
> > > set testwks = worksheets(cell.value)
> > > on error goto 0
> > > if testwks is nothing then
> > > 'it doesn't exist
> > > Sheets("Template").Copy after:=Worksheets(Worksheets.Count)
> > > ActiveSheet.Name = cell.Value
> > > else
> > > 'already exists
> > > end if
> > > End If
> > > Next
> > >
> > > Ardy wrote:
> > > >
> > > > Hello All:
> > > > I have this code that creates tabs from a list, my problem is that I
> > > > want to add to it, so it would prevent creating tab if the name already
> > > > exist and give a message, can anybody help me
> > > > ---------------------------------------------------------
> > > > Private Sub CommandButton3_Click()
> > > > ' Declair Variables
> > > > Dim iLastRow As Long, i As Long, sh As Worksheet, LastCell As Range
> > > > Dim Rng As Range, cell As Range, WS As Worksheet
> > > >
> > > > ' Start Create Student Tab From List in Column A Starting A2
> > > > With ActiveSheet
> > > >
> > > > iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
> > > > For i = iLastRow To 2 Step -1
> > > > .Hyperlinks.Add Anchor:=Cells(i, "A"), _
> > > > Address:="", _
> > > > SubAddress:="'" & Cells(i, "A").Value &
> > > > "'!A1", _
> > > > TextToDisplay:=Cells(i, "A").Value
> > > > Next i
> > > > End With
> > > > 'End Create Tab
> > > >
> > > > ' Start Creating Link From The List in Column A
> > > > ' to The Student Tabs Starting FromCell A2
> > > > Set WS = ActiveSheet
> > > > Set LastCell = WS.Cells(Rows.Count, "A").End(xlUp)
> > > > Set Rng = WS.Range("A2", LastCell)
> > > >
> > > > For Each cell In Rng
> > > > If Not IsEmpty(cell) Then
> > > > Sheets("Template").Copy after:=Worksheets(Worksheets.Count)
> > > > ActiveSheet.Name = cell.Value
> > > > End If
> > > > Next
> > > > ' End Creating Link
> > > >
> > > > ' Start Returning to Roster Tab
> > > > MakeVisible
> > > > Sheets("Template").Visible = False
> > > > Sheets("Template").Move Before:=Sheets(2)
> > > > Sheets("Roster").Select
> > > > Range("D2").Select
> > > > ' Start Inserting formula for Transfering data to Roster
> > > > ' module driven code
> > > > InsertInfoTransferFormula
> > > > CopyFormula
> > > > ' End Inserting Formula For Transfering data to Roster
> > > > ' Landing on Cell
> > > > Range("C1").Select
> > > > End Sub
> > > > ----------------------------------------------------------------
> > >
> > > --
> > >
> > > Dave Peterson
>
> --
>
> Dave Peterson