FillCDays()

G

Gina Whipp

Hey Guys (and Gals),

What I would like is if an Associate has more than one activity on any
single day it should show them all. (This end result shows in a calendar
style report.) Right ow it only shows the first activity. I have marked
what I think is the offending line (<--THIS LINE), any ideas without me
rewriting the whole thing?


Function FillCdays()
On Error Resume Next
Dim irow As Integer
Dim icol As Integer
Dim tuseday As String
Dim tcheckday As String
Dim ans As String
Dim db As DAO.Database
Dim qd As QueryDef
Set db = CurrentDb()
Dim rs As DAO.Recordset
Set qd = db.QueryDefs("qryFillCDays")
qd!FindMonth = Format([scrCDate], "m")
qd!FindYear = Me.txtYear
Set rs = qd.OpenRecordset()
Dim Done As Integer
Done = 0
If rs.EOF And rs.BOF Then
Else
Do Until rs.EOF
If Trim(rs!NameActivity & "") = "" Then
Else
ans = ""
For irow = 0 To 6
For icol = 0 To 9
tuseday = rs!Day
tcheckday = Trim(Left(Me("lbl" & irow & icol), 2))
If tcheckday = tuseday Then
Me("lbl" & irow & icol) = Me("lbl" & irow & icol) & vbCrLf
& rs!NameActivity <--- THIS LINE
Me("lbl" & irow & icol).FontWeight = 500
End If
If Done = 1 Then Exit For
Next icol
If Done = 1 Then Exit For
Next irow
End If

rs.MoveNext
Done = 0
Loop
End If
rs.Close
End Function
 
D

Dirk Goldgar

In
Gina Whipp said:
Hey Guys (and Gals),

What I would like is if an Associate has more than one activity on any
single day it should show them all. (This end result shows in a
calendar style report.) Right ow it only shows the first activity. I
have marked what I think is the offending line (<--THIS LINE), any
ideas without me rewriting the whole thing?


Function FillCdays()
On Error Resume Next
Dim irow As Integer
Dim icol As Integer
Dim tuseday As String
Dim tcheckday As String
Dim ans As String
Dim db As DAO.Database
Dim qd As QueryDef
Set db = CurrentDb()
Dim rs As DAO.Recordset
Set qd = db.QueryDefs("qryFillCDays")
qd!FindMonth = Format([scrCDate], "m")
qd!FindYear = Me.txtYear
Set rs = qd.OpenRecordset()
Dim Done As Integer
Done = 0
If rs.EOF And rs.BOF Then
Else
Do Until rs.EOF
If Trim(rs!NameActivity & "") = "" Then
Else
ans = ""
For irow = 0 To 6
For icol = 0 To 9
tuseday = rs!Day
tcheckday = Trim(Left(Me("lbl" & irow & icol), 2))
If tcheckday = tuseday Then
Me("lbl" & irow & icol) = Me("lbl" & irow & icol) &
vbCrLf & rs!NameActivity <--- THIS LINE
Me("lbl" & irow & icol).FontWeight = 500
End If
If Done = 1 Then Exit For
Next icol
If Done = 1 Then Exit For
Next irow
End If

rs.MoveNext
Done = 0
Loop
End If
rs.Close
End Function
Click to expand...

Looks like it ought to work, so long as the controls with names like
"lbl##" are text boxes, not labels. Have you stepped through the code
to verify that the suspect line is actually being executed more than
once for the same day?
 
G

Gina Whipp

Dirk,

I have looked at the underliing query which shows 5 lines on several days
but I am only getting the first line. And yes they are text boxes.

--
Gina Whipp

"I feel I have been denied critical, need to know, information!" - Tremors
II
Dirk Goldgar said:
In
Gina Whipp said:
Hey Guys (and Gals),

What I would like is if an Associate has more than one activity on any
single day it should show them all. (This end result shows in a
calendar style report.) Right ow it only shows the first activity. I
have marked what I think is the offending line (<--THIS LINE), any
ideas without me rewriting the whole thing?


Function FillCdays()
On Error Resume Next
Dim irow As Integer
Dim icol As Integer
Dim tuseday As String
Dim tcheckday As String
Dim ans As String
Dim db As DAO.Database
Dim qd As QueryDef
Set db = CurrentDb()
Dim rs As DAO.Recordset
Set qd = db.QueryDefs("qryFillCDays")
qd!FindMonth = Format([scrCDate], "m")
qd!FindYear = Me.txtYear
Set rs = qd.OpenRecordset()
Dim Done As Integer
Done = 0
If rs.EOF And rs.BOF Then
Else
Do Until rs.EOF
If Trim(rs!NameActivity & "") = "" Then
Else
ans = ""
For irow = 0 To 6
For icol = 0 To 9
tuseday = rs!Day
tcheckday = Trim(Left(Me("lbl" & irow & icol), 2))
If tcheckday = tuseday Then
Me("lbl" & irow & icol) = Me("lbl" & irow & icol) &
vbCrLf & rs!NameActivity <--- THIS LINE
Me("lbl" & irow & icol).FontWeight = 500
End If
If Done = 1 Then Exit For
Next icol
If Done = 1 Then Exit For
Next irow
End If

rs.MoveNext
Done = 0
Loop
End If
rs.Close
End Function
Click to expand...

Looks like it ought to work, so long as the controls with names like
"lbl##" are text boxes, not labels. Have you stepped through the code to
verify that the suspect line is actually being executed more than once for
the same day?

--
Dirk Goldgar, MS Access MVP
www.datagnostics.com

(please reply to the newsgroup)
Click to expand...
 
D

Dirk Goldgar

In
Gina Whipp said:
Dirk,

I have looked at the underliing query which shows 5 lines on several
days but I am only getting the first line.
Click to expand...

That's not the same as stepping through the code and seeing exactly what
happens. I suggest you set a breakpoint at the top of the routine
before doing whatever you do that causes the function to be called.
Then step through it line by line, when you know it's working on a day
that should have several lines.
 
G

Gina Whipp

Dirk,

Feeling stupid here.... but I can't step into the code behind a form, am I
doing something wrong?
 
G

Gina Whipp

It also dawns o me you have no idea how I fill the calendar, so here you
go...

Sub RefDates()
'Adapted from code by Joshua Painter whom I can't find

Dim D1 As Variant, D2 As Integer, D3 As Integer

Me.txtMonth = Format(Me![scrCDate], "mmmm") 'Sets the Month
Me.txtYear = Format(Me![scrCDate], "yyyy") 'Sets the Year

D1 = DateSerial(Year(Me![scrCDate]), Month(Me![scrCDate]), 1) 'Sets the
first day of the month
D2 = DatePart("w", D1, vbSunday) 'Sets the first day of the week
Do Until DatePart("w", D1, vbSunday) = 1 'Starts the calendar on the
first day of the week designated
D1 = DateAdd("d", -1, D1)
Loop
Me![scr1Date] = D1
D3 = 11
Do Until D3 > 52 'Goes thru all the calendar days setting the dates
'Me("lbl" & Format(D3, "00")) = Day(D1) 'Starts the calendar days
Me("lbl" & D3) = Day(D1) 'Starts the calendar days

If Month(D1) <> Month(Me![scrCDate]) Then
Me("lbl" & D3).Visible = False
Else
Me("lbl" & D3).ForeColor = 0
Me("lbl" & D3).Visible = True
End If

D3 = D3 + 1
D1 = DateAdd("d", 1, D1)
Loop
End Sub
 
D

Dirk Goldgar

In
Gina Whipp said:
Dirk,

Feeling stupid here.... but I can't step into the code behind a
form, am I doing something wrong?
Click to expand...

You can't directly step into the code behind a form. What you have to
do is set a breakpoint in the code, and then do whatever user action
will cause the code to be called. That action might be clicking on a
button, opening or closing the form, navigating to a new record, any
number of things. Presumably you know what circumstances cause that
function to be called, and can make it happen. Once you've done that,
the code will begin executing naturally, and will stop at the
breakpoint. From that point you can single-step through the code in the
usual way.
 
G

Gina Whipp

Dirk,

First, I keep saying form when in fact it is a report... Regardless, the
code worked for the 11th, 18th and 25th but nothing showed for the 4th?
Okay so it's not the offending line I thought it was. What I see know is
all my single digit days are showing me nothing.

Query shows days as "04"...

Just to keep all the code together...

Function FillCdays()
On Error Resume Next
Dim irow As Integer
Dim icol As Integer
Dim tuseday As String
Dim tcheckday As String
Dim ans As String
Dim db As DAO.Database
Dim qd As QueryDef
Set db = CurrentDb()
Dim rs As DAO.Recordset
Set qd = db.QueryDefs("qryFillCDays")
qd!FindMonth = Format([scrCDate], "mm")
qd!FindYear = Me.txtYear
Set rs = qd.OpenRecordset()
Dim Done As Integer
Done = 0
If rs.EOF And rs.BOF Then
Else
Do Until rs.EOF
If Trim(rs!NameActivity & "") = "" Then
Else
ans = ""
For irow = 1 To 6
For icol = 0 To 9
tuseday = rs!Day
tcheckday = Trim(Left(Me("lbl" & irow & icol), 2))
If tcheckday = tuseday Then
Me("lbl" & irow & icol) = Me("lbl" & irow & icol) & vbCrLf
& rs!NameActivity
Me("lbl" & irow & icol).FontWeight = 500
End If
If Done = 1 Then Exit For
Next icol
If Done = 1 Then Exit For
Next irow
End If

rs.MoveNext
Done = 0
Loop
End If
rs.Close
End Function

Sub RefDates()
'Adapted from code by Joshua Painter whom I can't find

Dim D1 As Variant, D2 As Integer, D3 As Integer

Me.txtMonth = Format(Me![scrCDate], "mmmm") 'Sets the Month
Me.txtYear = Format(Me![scrCDate], "yyyy") 'Sets the Year

D1 = DateSerial(Year(Me![scrCDate]), Month(Me![scrCDate]), 1) 'Sets the
first day of the month
D2 = DatePart("w", D1, vbSunday) 'Sets the first day of the week
Do Until DatePart("w", D1, vbSunday) = 1 'Starts the calendar on the
first day of the week designated
D1 = DateAdd("d", -1, D1)
Loop
Me![scr1Date] = D1
D3 = 1
Do Until D3 > 42 'Goes thru all the calendar days setting the dates
Me("lbl" & Format(D3, "00")) = Day(D1) 'Starts the calendar days

'If Month(D1) <> Month(Me![scrCDate]) Then <--- I remmed out, will
adjust whe I get it working.
'Me("lbl" & Format(D3, "00")).Visible = False
'Else
'Me("lbl" & Format(D3, "00")).ForeColor = 0
'Me("lbl" & Format(D3, "00")).Visible = True
'End If

D3 = D3 + 1
D1 = DateAdd("d", 1, D1)
Loop
End Sub
 
D

Douglas J. Steele

Is it possible that tuseday is 4 and tcheckday is 04 (or vice versa)?

Perhaps having them as integers rather than string might be a good idea.
 
G

Gina Whipp

Doug,

Okay tried that, NOW I get one item for the 4th and o the 11th, 18th and
25th I get 2 tasks which is correct. On the 4th I should see 7 activities.
 
D

Douglas J. Steele

I thought you originally indicated that your query returned 5 events:
I have looked at the underliing query which shows 5 lines on several days
but I am only getting the first line. And yes they are text boxes.
Click to expand...

1 for the 4th, 1 for the 11th, 1 for the 18th and 2 for the 25th adds up to
5.

You're not saying that a single row in the query can represent multiple
events, are you?
 
G

Gina Whipp

Doug,

I keep changing Associates.... I'll stop that. ANYWAY, I think I found
it...

tuseday = rs!Day
tcheckday = Trim(Left(Me("lbl" & irow & icol), 2))

If rs!Day = 1 thru 9 then tcheckday = Trim(Left(Me("lbl" & irow & icol), 1))
<--- see 1
If rs!Day = 10 thru whatever then tcheckday = Trim(Left(Me("lbl" & irow &
icol), 2)) <---see 2

ow I just have to write that into the code and I think it will work! I
tried:

If rs!cDay = 1 Or 2 Or 3 Or 4 Or 5 Or 6 Or 7 Or 8 Or 9 Then
tcheckday = Trim(Left(Me("lbl" & irow & icol), 1))
Else
tcheckday = Trim(Left(Me("lbl" & irow & icol), 2))
End If

And that didn't work but that was just test number 1!
 
G

Gina Whipp

Doug,

This seems to work...

If rs!cDay <= 9 Then
tcheckday = Trim(Left(Me("lbl" & irow & icol), 1))
Else
tcheckday = Trim(Left(Me("lbl" & irow & icol), 2))
End If
 
G

Gina Whipp

Without your questions and making me 'study' the code I would still be
pulling my hair out!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Remove Identical words 0
Instance of Excel running after closing Excel 3
Error message '13 Type Mismatch' HELP! 7
VBA Export to PDF 0
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
AddPicturesToShapes 0
VBA Coding Help for Beginner 0
Trying to Extract Embedded OLEs 0

Top