A real challenge for you!!

[mevetts]

Hi,

This is probably my most difficult section for the current workbook
that I'm producing.

To set the scene, I'm a teacher and I am creating a register and
markbook in excel. The reason being is that I'm aiming to be able to
actually use the data far more than if it was written down in on
paper.

However, I face a major hurdle. The register is taken during every
lesson and I personally like to undertake this process at the very
beginning of the lesson. The process needs to be very quick and
efficient so that the lesson can get underway as soon as possible.

At the moment I work with three possible options for a pupil - ontime,
late or absent. However, the hope is that this spreadsheet may get
adopted by other members of staff and they may want to tailor the
options to meet their requirements.

I have tried simply copying and pasting from a key of symbols to record
the info, but this proved too fidly and time consuming.

Validation also turned out to be too slow and the inability to display
the actually symbols in the drop down list made it next too useless.

I have tried out creating macros and assigning them to buttons and this
has proved out to be the most successful so far.

However, I have seen (and downloaded) a spreadsheet that allows a
simple click to input a tick into a column. It was very quick and
worked well. I was wondering if the code could perhaps be adapted in
some way to meet the results I want.

Can the number of clicks determine the symbol i.e. it sort of scrolls
through the possible options with a left mouse click and a double click
moves it to the next cell down?

Anyway, here's the code I downloaded -

Code written by Nick Hodge
15/11/04
Contained in this worksheet's code module
It detects a click in columns D or E and then inserts a tick mark. It
then moves to column G in the same row. Clicking on a tick, removes it
and moves you to column G

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iOffset As Integer
On Error GoTo err_handler
Application.EnableEvents = False
If Not Application.Intersect(Target, Columns("D:E")) Is Nothing Then
If Target.Column = 4 Then
iOffset = 3
Else
iOffset = 2
End If
If IsEmpty(Target.Value) Then
With Target
..Font.Name = "Wingdings"
..Value = Chr(252)
End With
Target.Offset(0, iOffset).Select
Else
Target.Value = ""
Target.Offset(0, iOffset).Select
End If
End If
err_handler:
Application.EnableEvents = True
End Sub

Any help would be great and I know some of you enjoy a challenge!

Thanks,

Mark.

 

[Guest]

presumably you will mark the absent students as absent,and modify that to
late if the arrive later?How many students?,what about three radio buttons
per line marked present absent late?

hope this helps
paul
remove nospam for email addy!

 

[mevetts]

It is a possibility, but the only issue will be that if a teacher has
twenty or so pupils then it could become very crowded on the screen.

I want to keep the workbook as clean as possible as I believe this will
facilitate easy of use.

Cheers,

Mark.

 

[Bob Phillips]

Here is a method that just cycles through the 3 symbols on selecting the
cell

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iOffset As Integer
On Error GoTo err_handler
Application.EnableEvents = False
If Not Application.Intersect(Target, Columns("D:E")) Is Nothing Then
With Target
.Font.Name = "Marlett"
Select Case .Value
Case "", "r": .Value = "a"
Case "", "a": .Value = "p"
Case "", "p": .Value = "r"
End Select
.Offset(0, 1).Select
End With
End If
err_handler:
Application.EnableEvents = True
End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Pete]

Mark,

I've been involved in register packages in the past. I think the
quickest approach is to assume all pupils are present (i.e. have a
"Fill Present" option/button) and then just mark the pupils who are
absent. If they then subsequently turn up late, it's easy enough (if
you remember at the time) to change their absence to a late mark.

Just a thought ...

Pete

 

[mevetts]

RP - Thanks, this is a help because I can now see how the code would go
if I decide to take that route.

Pete - I think you might be right and I believe one of my colleagues
who has been helping develop the workbook took this approach with his
trialing.

I have this code already in place which inserts today's date at the top
of the column -

Public Sub Date_Today()
With ActiveCell
Value = Date
NumberFormat = "dd-mmm-yy"
End With
ActiveCell.Offset(1, 0).Select
End Sub

Could this be extended so that it put a tick or letter or symbol next
to each pupil?

The code would need to look and see if there is a number in column A
(each pupil is numbered) and put a tick in the corresponding cell. It
would continue down the list until there was a blank in column A.

Can anyone achieve this?

Thanks,

Mark.

 

[keepITcool]

I think Pete's is a good approach

for the entry of the tickmarks why not create a commandbar?
put code in a NORMAL module

Option Explicit

Sub BuildBar()
Const BARNAME = "TickMarks"
With Application
On Error Resume Next
.CommandBars(BARNAME).Delete
On Error GoTo 0
With .CommandBars.Add(BARNAME, msoBarTop, , True)
With .Controls.Add(, , 1, , True)
.Caption = "OnTime"
.FaceId = 1087
.OnAction = ThisWorkbook.Name & "!buttonhandler"
End With
With .Controls.Add(, , 2, , True)
.Caption = "Absent"
.FaceId = 1088
.OnAction = ThisWorkbook.Name & "!buttonhandler"
End With
With .Controls.Add(, , 3, , True)
.Caption = "Late"
.FaceId = 1089
.OnAction = ThisWorkbook.Name & "!buttonhandler"
End With
.Visible = True
End With
End With
End Sub

Public Sub ButtonHandler()
Dim sWD$
sWD = Chr$(Choose(Application.CommandBars.ActionControl.Parameter, _
252, 251, 220))
With ActiveCell
With .EntireRow.Cells(1)
.Font.Name = "Wingdings"
.Value = sWD
End With
.Offset(1).Activate
End With
End Sub


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Pete wrote :

 

[mevetts]

.....I'm what you call a novice at all this and that really just wen
over my head!

Could you explain that in a little more plain English for me

 

[mevetts]

Is it something to do with creating a custom toolbar which is attached
to a specfic workbook?

 

[keepITcool]

You were posting code earlier, so I assume
you know how to create a module and copy/paste the code into that..

Why dont you give it a try...

the macro creates a temporary toolbar.
(gone when you restart excel)

it could be called from the Workbook_Open event
so it loads when the workbook opens.
and similarly could be deleted on workbook_beforeclose

But that is all secondary...
First thing.. does using a toolbar to enter the ticks work for you.

--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


mevetts wrote :

 

[Bob Phillips]

Public Sub Date_Today()
Dim iLastrow As Long
Dim i As Long
Dim nHeight As Double

iLastrow = Cells(Rows.Count, "A").End(xlUp).Row

With ActiveCell
Cells(1, .Column).Value = Date
Cells(1, .Column).NumberFormat = "dd-mmm-yy"
For i = 2 To iLastrow
With Cells(i, .Column)
nHeight = .EntireRow.Height
.Value = "p"
.Font.Name = "Marlett"
.EntireRow.RowHeight = nHeight
End With
Next i
End With
End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[mevetts]

Hi,

Bob - I tested your code, but it went a bit mad when I ran the macro.
It put symbols in all the cells in that column (below the active cell),
rather than stopping at the end of the pupil list in that particular
class register.

KeepITcool - I have put the code in and it creates the toolbar when the
macro is run. However, the symbol is placed in column A, rather than the
active cell?

Can the code be altered to rectify this?

Also, it is possible to develop a button the will put a tick next to
all pupils in the particular register on the screen? The macro needs to
look and see if there is a number in column A, if there is put a tick in
the corresponding cell in the column being used for that particular days
register.

I've attached a screenshot of an example register so that it may help
explain what I'm working with and trying to achieve!

Any help would be really appreciated.

Mark.


+-------------------------------------------------------------------+
|Filename: screen.jpg |
|Download: http://www.excelforum.com/attachment.php?postid=4158 |
+-------------------------------------------------------------------+

 

[Bob Phillips]

Hi,

Bob - I tested your code, but it went a bit mad when I ran the macro.
It put symbols in all the cells in that column (below the active cell),
rather than stopping at the end of the pupil list in that particular
class register.

Probably because I tested column A for the pupil numbers. If it is somewhere
else the coide should be modified.

KeepITcool - I have put the code in and it creates the toolbar when the
macro is run. However, the symbol is placed in column A, rather than the
active cell?

Can the code be altered to rectify this?

Public Sub ButtonHandler()
Dim sWD$
sWD = Chr$(Choose(Application.CommandBars.ActionControl.Parameter, _
252, 251, 220))
With ActiveCell
.Font.Name = "Wingdings"
.Value = sWD
.Offset(1).Activate
End With
End Sub

Also, it is possible to develop a button the will put a tick next to
all pupils in the particular register on the screen? The macro needs to
look and see if there is a number in column A, if there is put a tick in
the corresponding cell in the column being used for that particular days
register.

That was what the code I gave does. I fail to understand what you say it
does.

 

[mevetts]

Hi Bob,

When I ran the macro it put symbols in, but rather than stopping at the
end of the class list, it jumped down to the next class and carried on
placing symbols next to each of their names as well.

I would like it to stop placing the symbol in each row at the end of
the list of names for that particular class. That is why I want it to
check if there is a number in column A, if there is then insert the
symbol, if there isn't then the macro should end.

See my screen shot to get an idea of what I mean.

Cheers,

Mark.

 

[Bob Phillips]

Try this. You need to select a cell in the sub-heading row, 56 in your
example

Public Sub Date_Today()
Dim iLastrow As Long
Dim i As Long
Dim nHeight As Double

iLastrow = Cells(Activecell.Row, "A").End(xlDown).Row

With ActiveCell
Cells(1, .Column).Value = Date
Cells(1, .Column).NumberFormat = "dd-mmm-yy"
For i = 2 To iLastrow
With Cells(i, .Column)
nHeight = .EntireRow.Height
.Value = "p"
.Font.Name = "Marlett"
.EntireRow.RowHeight = nHeight
End With
Next i
End With
End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[mevetts]

Hi Bob,

That code doesn't seem to work either. If I select the cell where th
date should be inserted and click the date button a symbol is entere
rather than today's date. Then all the cells above the active cel i
the same column have the symbol entered.

If however, I move the one row down next to the row that corresponds t
the first pupil in the list and run the macro, then it does put a symbo
next to each of the pupils in that list and it does stop at the las
pupil.

Not sure what needs to be altered?

Thanks,

Mark

 

[Bob Phillips]

Public Sub Date_Today()
Dim iLastrow As Long
Dim i As Long
Dim nHeight As Double

iLastrow = Cells(ActiveCell.Row, "A").End(xlDown).Row

With ActiveCell
Cells(.Row, .Column).Value = Date
Cells(.Row, .Column).NumberFormat = "dd-mmm-yy"
Cells(.Row, .Column).Font.Name = "Arial"
For i = .Row + 1 To iLastrow
With Cells(i, .Column)
nHeight = .EntireRow.Height
.Value = "a"
.Font.Name = "Marlett"
.EntireRow.RowHeight = nHeight
End With
Next i
End With
End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[mevetts]

Hi Bob,

All it does now is just put the date in the active cell. It's not even
moving down to the next row.

Not sure what too do.

I've tried looking at the code, but it is still not making a huge
amount of sense to me yet.

Do you think you could take a look.

Mark.

 

[Bob Phillips]

It's the damn merged cells, it takes the cells merged in as empty cells, so
nowhere to populate. Get rid of them, they are more trouble le than they
are worth.

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[mevetts]

Bob,

I removed the merge, but the same thing happened, although it did move
down to the next row this time, but then stopped.