PDA

View Full Version : Multi Tracker Entry Help



kantian1
07-19-2008, 06:39 AM
Hi,

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.

Thanks.

Bob Phillips
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

kantian1
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?


Thanks.

Bob Phillips
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?

kantian1
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?

Thanks.

Bob Phillips
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, _
SearchFormat:=False)
On Error GoTo 0
If Not rFound Is Nothing Then

rRow = rFound.Row
Else

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
Else

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

Sheets(OriginalSheet).Activate
Application.ScreenUpdating = True


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

MsgBox "Entry successfully added", vbInformation

End Sub

kantian1
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?

Thanks.

Bob Phillips
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

kantian1
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?

Thanks.

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

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

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

Thanks.

Bob Phillips
07-20-2008, 11:20 AM
.

kantian1
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.