View Full Version : Multi Tracker Entry Help

07-19-2008, 06:39 AM

I posted a couple of times before, but never included the file and was a bit vague.

I've attached a Tracker Sheet that tracks whether a time sheet has been received or not, Have a look. What I want to do is replace the combobox with all the employees names in with a multi selection box so that more than one employee can be selected and therefore multiple entries can be added in one button click.

Once the entries have been added I need a msgbox to display how many entries were added.

You can access the Tracker form by going to 'Data' on the ribbon (if you have Excel 2007) and selecting the tracker icon.
All passwords have been removed.


07-19-2008, 07:43 AM
Couldn't test it because it is assuming US dates and I'm in the UK, and I couldn't be bothered to fix that

07-19-2008, 08:03 AM
Hi xld,

Wow, you got it. I works fine with me, remember you have to expand the tables first to add an entry.

Test it again and see what you think.

I have another problem, if the user selects a date that not on the sheet.
it goes to the debugger?

Any thoughts on this?


07-19-2008, 08:14 AM
I still can't get it to work, even expanded, but no matter.

It errors (which it always does for me because I never find dates) because when it hits this line

Cells(rRow, dCol).Select

the date column and resource row have not been initialised. Test for this

If rRow <> 0 And dCol <> 0 Then Cells(rRow, dCol).Select

Expanding/collapsing is somewhat better?

07-19-2008, 08:22 AM
Yes it errors on this line for me as well:

Cells(rRow, dCol).Select

But only when I select a date that is not on the sheet?

How can I get a msgbox up to display 'incorrect date or name has been selected'? when the user selects the wrong date or name?


07-19-2008, 08:39 AM
You can't not find a resource, the listbox is populated from available names - didn't you ougt to sort these?

Private Sub CommandButton1_Click()
Dim i As Long
Dim rng As Range

Sheet1.Unprotect Password:="machine"
Sheet2.Unprotect Password:="machine"

Dim Sht As Worksheet
Dim rFound As Range, dFound As Range
Dim rRow As Long, dCol As Long
Dim OriginalSheet As String

OriginalSheet = ActiveSheet.Name

Application.ScreenUpdating = False
For Each Sht In Sheets

If Sht.Name = "Sheet1" Then GoTo Nxt
On Error Resume Next

Set dFound = Cells.Find(What:=Me.DTPicker1.Value, After:=Range("C22"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)

On Error GoTo 0
If Not dFound Is Nothing Then

dCol = dFound.Column

For i = 0 To lstEmployees.ListCount - 1

If lstEmployees.Selected(i) Then

On Error Resume Next

Set rFound = Nothing
Set rng = Range("C" & dFound.Row - 1 & ":C" & Range("C" & Rows.Count).End(xlUp).Row)
Set rFound = rng.Find(What:=Me.lstEmployees.List(i), _
After:=Range("C" & dFound.Row - 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
On Error GoTo 0
If Not rFound Is Nothing Then

rRow = rFound.Row

MsgBox "Name Not Found On Sheet" & Sht.Name
GoTo Nxt
End If

Cells(rRow, dCol).Interior.ColorIndex = 10

Cells(rRow, dCol).Value = "RECEIVED"
Cells(rRow, dCol).Font.ColorIndex = 2
Cells(rRow, dCol).Font.Bold = True
End If
Next i

MsgBox "Date Not Found on Sheet " & Sht.Name
End If
Next Sht

Application.ScreenUpdating = True

If rRow <> 0 And dCol <> 0 Then Cells(rRow, dCol).Select

MsgBox "Entry successfully added", vbInformation

End Sub

07-19-2008, 08:48 AM
It's the wrong date that is causing the problem, if the user selects any date from the date picker that is not on the sheet then this causes the problem as mentioned above. If I could condition the calendar to display only week ending dates (Sunday dates) then there would not be a problem, unfortunately the user is able to pick any date they desire.

Also your new line of code If rRow <> 0 And dCol <> 0 Then Cells(rRow, dCol).Select works fine to get rid of this error but displays the message box 'entry successfully added' even though an entry has not been added?

What do you think?


07-19-2008, 10:27 AM
Okay, maybe

If rRow <> 0 And dCol <> 0 Then

Cells(rRow, dCol).Select
MsgBox "Entry successfully added", vbInformation
End If

07-19-2008, 11:04 AM
That works perfect, thanks.

This is the last time I'll bother you, there seems to be another little bug in the code. If there is a user error, the MsgBox "Name Not Found On Sheet" & Sht.Name and MsgBox "Date Not Found on Sheet " & Sht.Name show themselves, but I want one message box to show just stating an error.

The code I have here seems to go through all the sheets looking for the criteria, but I only want it to go through the currently selected sheet.

Can you see and amend the problem?


07-19-2008, 12:13 PM
What sort of user error?

07-19-2008, 12:19 PM
If the wrong date is entered or name.

07-20-2008, 10:56 AM
Any one? Any ideas?


07-20-2008, 11:20 AM

07-20-2008, 12:32 PM
Nice one xld, you are a star.

Just a quick question, I know a little VBA, but in your opinion what is the best way of learning it to your standard?

Thanks again.