Running a Check prior to crating tabs.
 

Hello All:
I am a little stuck on this issue. I have gotten a code by the help
of this user group, well the core functions and have been tweaking it,
as best as I could to fit my purpose. This code will create tabs
using Column A (starting A2 - which is the list of names) each name
will get its own tab copying a hidden template tab. My problem is that
column B (starting B2 - Which is student ID number) also needs to be
inputted. So if user enters all the names and forgets to input
students ID's then once he/she activates the function the code will
stop and give notice that student x doesn't have ID number, code will
stop. It's like running a check to make sure we have all student IDs
prior to making tabs.
--------------------------------------------------
Sub MakeStudentTab(x As Byte)
' Add Student Make Tab

Dim iLastRow As Long, i As Long, sh As Worksheet, LastCell As Range
Dim Rng As Range, Cell As Range, ws As Worksheet, LastRow As Long
Dim NumberOfCell As Long

' I am assuming the code needs to go here prior to all other
functions, then again
' I might be wrong.


Sheets("PA-DWR Detail").Visible = True ' Make PA-DWR Visable
If Application.CountA(Range("A2:A43")) = 0 Then
MsgBox ("Please Enter Students Name Prior to Creating
Tabs")
End
Else
StudentNameTransfer x ' To Transfer Names Prior to Making
Link (Module 1)
' x will make the procedure
available
' Get Count of Students and place it in Msg Box
NumberOfCell = Application.CountA(Range("A2:A43"))
MsgBox ("Creating") & " " & NumberOfCell & " " & "Student
Tabs"
End If
' End if Statement for if the roster is empty stop processing
' 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 From Cell A2
'
Set ws = ActiveSheet
Set LastCell = ws.Cells(Rows.Count, "A").End(xlUp)
Set Rng = ws.Range("A2", LastCell)
MakeVisible x ' x is to use the procedure Module 1
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
'Sheets("Template").Visible = False
Sheets("Template").Move Befo=Sheets(2)
Worksheets("Template").Visible = xlVeryHidden
Sheets("Roster").Select
Range("D2").Select
' Start Copying formula for date transfer from student
' tabs to the roster tab
UnLockSheet x ' un-protect the roster tab module 1
' --------------Start copying formula for transfering data
InsertInfoTransferFormula x 'From Module 1
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
If LastRow 2 Then
.Range("C2:ER2").AutoFill Destination:=.Range("C2:ER" & LastRow),
_
Type:=xlFillDefault
End If
End With
' --------------End copying formula for transfering data
' BorderChangeRoster x ' From Module 1
LockSheet x ' Protect the roster tab Module 1
' x is the dim variable from top to hide the code in
' macro window
Range("B2").Select
UserForm1.Hide
End Sub

Running a Check prior to crating tabs.
 

Can you check before you start?

Dim NameRng as range
with activesheet
if isempty(.range("a2")) then
msgbox "A2 cannot be empty."
exit sub
end if

set namerng = .range("a2",.cells(.rows.count,"A").end(xlup))

if namerng.cells.count = application.counta(namerng) then
'no empties, keep going
else
msgbox "No empty cells starting with A2"
exit sub
end if

if namerng.cells.count = application.counta(namerng.offset(0,1)) then
'at least every name has an id, keep going
else
msgbox "At least one name is missing its ID"
exit sub
end if
end with

========




Ardy wrote:

Hello All:
I am a little stuck on this issue. I have gotten a code by the help
of this user group, well the core functions and have been tweaking it,
as best as I could to fit my purpose. This code will create tabs
using Column A (starting A2 - which is the list of names) each name
will get its own tab copying a hidden template tab. My problem is that
column B (starting B2 - Which is student ID number) also needs to be
inputted. So if user enters all the names and forgets to input
students ID's then once he/she activates the function the code will
stop and give notice that student x doesn't have ID number, code will
stop. It's like running a check to make sure we have all student IDs
prior to making tabs.
--------------------------------------------------
Sub MakeStudentTab(x As Byte)
' Add Student Make Tab

Dim iLastRow As Long, i As Long, sh As Worksheet, LastCell As Range
Dim Rng As Range, Cell As Range, ws As Worksheet, LastRow As Long
Dim NumberOfCell As Long

' I am assuming the code needs to go here prior to all other
functions, then again
' I might be wrong.

Sheets("PA-DWR Detail").Visible = True ' Make PA-DWR Visable
If Application.CountA(Range("A2:A43")) = 0 Then
MsgBox ("Please Enter Students Name Prior to Creating
Tabs")
End
Else
StudentNameTransfer x ' To Transfer Names Prior to Making
Link (Module 1)
' x will make the procedure
available
' Get Count of Students and place it in Msg Box
NumberOfCell = Application.CountA(Range("A2:A43"))
MsgBox ("Creating") & " " & NumberOfCell & " " & "Student
Tabs"
End If
' End if Statement for if the roster is empty stop processing
' 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 From Cell A2
'
Set ws = ActiveSheet
Set LastCell = ws.Cells(Rows.Count, "A").End(xlUp)
Set Rng = ws.Range("A2", LastCell)
MakeVisible x ' x is to use the procedure Module 1
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
'Sheets("Template").Visible = False
Sheets("Template").Move Befo=Sheets(2)
Worksheets("Template").Visible = xlVeryHidden
Sheets("Roster").Select
Range("D2").Select
' Start Copying formula for date transfer from student
' tabs to the roster tab
UnLockSheet x ' un-protect the roster tab module 1
' --------------Start copying formula for transfering data
InsertInfoTransferFormula x 'From Module 1
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
If LastRow 2 Then
.Range("C2:ER2").AutoFill Destination:=.Range("C2:ER" & LastRow),
_
Type:=xlFillDefault
End If
End With
' --------------End copying formula for transfering data
' BorderChangeRoster x ' From Module 1
LockSheet x ' Protect the roster tab Module 1
' x is the dim variable from top to hide the code in
' macro window
Range("B2").Select
UserForm1.Hide
End Sub

--

Dave Peterson

Running a Check prior to crating tabs.
 

On Jun 22, 4:14 pm, Dave Peterson wrote:
Can you check before you start?

Dim NameRng as range
with activesheet
if isempty(.range("a2")) then
msgbox "A2 cannot be empty."
exit sub
end if

set namerng = .range("a2",.cells(.rows.count,"A").end(xlup))

if namerng.cells.count = application.counta(namerng) then
'no empties, keep going
else
msgbox "No empty cells starting with A2"
exit sub
end if

if namerng.cells.count = application.counta(namerng.offset(0,1)) then
'at least every name has an id, keep going
else
msgbox "At least one name is missing its ID"
exit sub
end if
end with

========



Ardy wrote:

Hello All:
I am a little stuck on this issue. I have gotten a code by the help
of this user group, well the core functions and have been tweaking it,
as best as I could to fit my purpose. This code will create tabs
using Column A (starting A2 - which is the list of names) each name
will get its own tab copying a hidden template tab. My problem is that
column B (starting B2 - Which is student ID number) also needs to be
inputted. So if user enters all the names and forgets to input
students ID's then once he/she activates the function the code will
stop and give notice that student x doesn't have ID number, code will
stop. It's like running a check to make sure we have all student IDs
prior to making tabs.
--------------------------------------------------
Sub MakeStudentTab(x As Byte)
' Add Student Make Tab

Dim iLastRow As Long, i As Long, sh As Worksheet, LastCell As Range
Dim Rng As Range, Cell As Range, ws As Worksheet, LastRow As Long
Dim NumberOfCell As Long

' I am assuming the code needs to go here prior to all other
functions, then again
' I might be wrong.

Sheets("PA-DWR Detail").Visible = True ' Make PA-DWR Visable
If Application.CountA(Range("A2:A43")) = 0 Then
MsgBox ("Please Enter Students Name Prior to Creating
Tabs")
End
Else
StudentNameTransfer x ' To Transfer Names Prior to Making
Link (Module 1)
' x will make the procedure
available
' Get Count of Students and place it in Msg Box
NumberOfCell = Application.CountA(Range("A2:A43"))
MsgBox ("Creating") & " " & NumberOfCell & " " & "Student
Tabs"
End If
' End if Statement for if the roster is empty stop processing
' 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 From Cell A2
'
Set ws = ActiveSheet
Set LastCell = ws.Cells(Rows.Count, "A").End(xlUp)
Set Rng = ws.Range("A2", LastCell)
MakeVisible x ' x is to use the procedure Module 1
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
'Sheets("Template").Visible = False
Sheets("Template").Move Befo=Sheets(2)
Worksheets("Template").Visible = xlVeryHidden
Sheets("Roster").Select
Range("D2").Select
' Start Copying formula for date transfer from student
' tabs to the roster tab
UnLockSheet x ' un-protect the roster tab module 1
' --------------Start copying formula for transfering data
InsertInfoTransferFormula x 'From Module 1
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
If LastRow 2 Then
.Range("C2:ER2").AutoFill Destination:=.Range("C2:ER" & LastRow),
_
Type:=xlFillDefault
End If
End With
' --------------End copying formula for transfering data
' BorderChangeRoster x ' From Module 1
LockSheet x ' Protect the roster tab Module 1
' x is the dim variable from top to hide the code in
' macro window
Range("B2").Select
UserForm1.Hide
End Sub

--

Dave Peterson

Dave:
Sorry for getting back on this so late. Got busy with family. I ttok
your suggestion and am running the check as an seperate module
incorporating it to the code I had earliear. works good. World of
thank. dose the trick.

Ardy