Running a Check prior to crating tabs.

[Ardy]

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 Before:=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]

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]

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

========

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