Solved

VBA Loop - Can you make the first and last loop different from the others?

Posted on 2015-01-29
25
117 Views
Last Modified: 2016-02-10
Hi Everyone!

I have a loop in my vba code that moves data from an Access database into an Excel spreadsheet.

Is it possible to have the first and last times through the loop format the cells differently than the rest of the times?

The code inserts a list of items into an Excel spreadsheet. When the first item is entered, I want it to say "Meetings" before it ("Meeting" & vbCrLf & Item). When the code loops back, I don't want it to say "Meeting." I just want the item entered.
Then, when the last item is entered, I want to set the border weight on the bottom of the cell to xlMedium.

I am not sure where to start with this, so any direction given will be greatly appreciated (as always)!
0
Comment
Question by:Megin
  • 13
  • 10
  • +1
25 Comments
 
LVL 28

Expert Comment

by:omgang
ID: 40578554
"Meeting" & vbCrLf & Item
So you want Meeting to be entered into the first Excel cell and then Item entered into the next cell?
If yes, start off by writing "Meeting" to the desired cell; do this prior to beginning the loop.
Then, after the loop is complete, you can issue the necessary commands to format the border.

If you are writing all to the same Excel cell then it's a bit different but not much.
OM Gang
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 40578559
where is the code?
0
 
LVL 18

Expert Comment

by:SimonAdept
ID: 40578567
Yes, it's possible. store the rowcount in a variable first.

Pseudocode:

ctr = rs.recordcount
for x =1 to ctr
if x =1
'do first item stuff
else if x <ctr then
'do normal stuff
elseif x=ctr then
'do last record stuff
end if
next x
0
 

Author Comment

by:Megin
ID: 40578715
Okay, I am still a little confused.

First: OMGANG: The "Meetings" has to be in the same cell as the first item. Then the next go into the cells below. One item per cell.

Ray: Here is the code. The actdesc is where I want "Meeting" to go, but only in front of the first item inserted and only for Case 1. I would also like to have a border at the bottom of the cell of the last actdesc item that is inserted, but if I feel like that would be like asking for a pony for Christmas.

Do Until rs.EOF
    If rs!TaskOrderDesc = TheTO Then
        If rs!SubTaskDesc = TheSTOname Then
            If TheStaffName = rs!ReportAs Then
                If TheActDesc = rs!ActivityDesc Then
                    rs.MoveNext
                Else
                    TheTypeID = rs!ActivityTypeID
                    Select Case TheTypeID
                        Case 1
                      
                            oSheet.Cells(iRow, 3).Value = "     * " & rs!ActivityDesc
                            oSheet.Cells(iRow, 3).Font.Size = 10
                            oSheet.Cells(iRow, 3).Font.Name = "Arial"
                            oSheet.Cells(iRow, 3).IndentLevel = 1
                            oSheet.Cells(iRow, 3).WrapText = True
                            oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                            oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                            oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                            
                        Case 3
                            oSheet.Cells(iRow, 3).Value = "- " & rs!ActivityDesc
                            oSheet.Cells(iRow, 3).Font.Size = 10
                            oSheet.Cells(iRow, 3).Font.Name = "Arial"
                            oSheet.Cells(iRow, 3).IndentLevel = 1
                            oSheet.Cells(iRow, 3).WrapText = True
                            oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                            oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                            oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                                
                        Case Else
                            oSheet.Cells(iRow, 3).Value = rs!ActivityDesc
                    End Select
                    iRow = iRow + 1
                    rs.MoveNext
                    TheActDesc = ""
                End If
            Else
                oSheet.Cells(iRow, 2).Value = rs!ReportAs
                Set C = oSheet.Cells(iRow, 2)
                With C
                    Call formatItem(C, "Arial", False, 12, 0, _
                    xlAutomatic, xlContinuous, _
                    xlThin, xlThin, xlMedium, xlThin, _
                    xlMedium, xlThin, True, 54.75, xlTop)
                End With
                TheStaffName = rs!ReportAs
            End If
        Else
            oSheet.Cells(iRow, 1).Value = rs!SubTaskDesc
            Set C = oSheet.Cells(iRow, 1)
            With C
            Call formatItem(C, "Arial", False, 12, 0, _
                    xlAutomatic, xlContinuous, _
                    xlThin, xlThin, xlThin, xlMedium, _
                    xlThin, xlThin, True, 54.75, xlTop)
            End With
            TheSTOname = rs!SubTaskDesc
            TheStaffName = ""
        End If
    Else
        
        oSheet.Cells(iRow, 1).Value = "Detail Report" & vbCrLf & rs!TaskOrderDesc
        Set C = oSheet.Cells(iRow, 1)
        Range(C.Cells, C.Cells.Offset(0, 1)).Select

        Selection.Merge

        Set C = Selection
        With C
        Call formatItem(C, "Arial", True, 12, 15, _
                xlAutomatic, xlContinuous, _
                xlMedium, xlThin, xlThin, xlMedium, _
                xlMedium, xlThin, True, 54.75, xlTop)
        End With
Set C = oSheet.Cells(iRow, 3)
With C
        Call formatItem(C, "Arial", True, 12, 15, _
                xlAutomatic, xlContinuous, _
                xlMedium, xlThin, xlThin, xlMedium, _
                xlMedium, xlThin, True, 54.75, xlTop)
End With
        iRow = iRow + 1
        TheTO = rs!TaskOrderDesc

    End If

skiped:
 Loop

Open in new window


Simon: I am still confused about how to use that. And before I get any further, will that work within the code posted above? I already have some If statements and Case statements.
0
 
LVL 18

Expert Comment

by:SimonAdept
ID: 40578730
Hi Megin,

Yes it will work. The difference is that your doing a 'do until EOF' loop rather than a counter loop.

BEFORE your current line 1 add these lines:

dim ctr as long
rs.movelast
rs.movefirst 'move last then first to ensure the recordcount is true
rsRows = rs.recordcount

Then between your line  1 and line 2, add this
ctr=ctr+1

You can then check the ctr value anywhere else in the loop.
If ctr=1, then do your 'first loop' exception logic
if ctr=rsRows, then do your 'last loop' exception logic
0
 

Author Comment

by:Megin
ID: 40578732
I have to leave the office now, but I will be trying this tomorrow.

Thank you!!!!!
0
 

Author Comment

by:Megin
ID: 40585082
So,  am I putting the case section into this new If section?

I think I see what you are saying with this, but I am still having trouble fitting it into the entire code.
The way I have begin plugging it in is causing me errors indicating that I have an else statement without an if. Is this what you meant?
(I have only plugged the first statement in. I haven't added the ctr = rsRows yet.

Also, I declared rsRows, which was not originally in my declarations.

rs.MoveLast
rs.MoveFirst
rsrows = rs.RecordCount


Do Until rs.EOF
ctr = ctr + 1

    If rs!TaskOrderDesc = TheTO Then
        If rs!SubTaskDesc = TheSTOname Then
            If TheStaffName = rs!ReportAs Then
                If TheActDesc = rs!ActivityDesc Then
                    rs.MoveNext
                Else
                    TheTypeID = rs!ActivityTypeID
                    If ctr = 1 Then
                    Select Case TheTypeID
                        Case 1
                      
                            oSheet.Cells(iRow, 3).Value = "Participated in meetings:" & vbCrLf & "     * " & rs!ActivityDesc
                            oSheet.Cells(iRow, 3).Font.Size = 10
                            oSheet.Cells(iRow, 3).Font.Name = "Arial"
                            oSheet.Cells(iRow, 3).IndentLevel = 1
                            oSheet.Cells(iRow, 3).WrapText = True
                            oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                            oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                            oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                            
                        Case 3
                            oSheet.Cells(iRow, 3).Value = "- " & rs!ActivityDesc
                            oSheet.Cells(iRow, 3).Font.Size = 10
                            oSheet.Cells(iRow, 3).Font.Name = "Arial"
                            oSheet.Cells(iRow, 3).IndentLevel = 1
                            oSheet.Cells(iRow, 3).WrapText = True
                            oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                            oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                            oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                                
                        Case Else
                            oSheet.Cells(iRow, 3).Value = rs!ActivityDesc
                    End Select
                    Else
                    Select Case TheTypeID
                        Case 1
                      
                            oSheet.Cells(iRow, 3).Value = "Participated in meetings:" & vbCrLf & "     * " & rs!ActivityDesc
                            oSheet.Cells(iRow, 3).Font.Size = 10
                            oSheet.Cells(iRow, 3).Font.Name = "Arial"
                            oSheet.Cells(iRow, 3).IndentLevel = 1
                            oSheet.Cells(iRow, 3).WrapText = True
                            oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                            oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                            oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                            
                        Case 3
                            oSheet.Cells(iRow, 3).Value = "- " & rs!ActivityDesc
                            oSheet.Cells(iRow, 3).Font.Size = 10
                            oSheet.Cells(iRow, 3).Font.Name = "Arial"
                            oSheet.Cells(iRow, 3).IndentLevel = 1
                            oSheet.Cells(iRow, 3).WrapText = True
                            oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                            oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                            oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                            oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                                
                        Case Else
                            oSheet.Cells(iRow, 3).Value = rs!ActivityDesc
                    End Select
                    iRow = iRow + 1
                    rs.MoveNext
                    TheActDesc = ""
                End If
           Else
                oSheet.Cells(iRow, 2).Value = rs!ReportAs
                Set C = oSheet.Cells(iRow, 2)
                With C
                    Call formatItem(C, "Arial", False, 12, 0, _
                    xlAutomatic, xlContinuous, _
                    xlThin, xlThin, xlMedium, xlThin, _
                    xlMedium, xlThin, True, 54.75, xlTop)
                End With
                TheStaffName = rs!ReportAs
            End If
        Else
            oSheet.Cells(iRow, 1).Value = rs!SubTaskDesc
            Set C = oSheet.Cells(iRow, 1)
            With C
            Call formatItem(C, "Arial", False, 12, 0, _
                    xlAutomatic, xlContinuous, _
                    xlThin, xlThin, xlThin, xlMedium, _
                    xlThin, xlThin, True, 54.75, xlTop)
            End With
            TheSTOname = rs!SubTaskDesc
            TheStaffName = ""
        End If
    Else
        
        oSheet.Cells(iRow, 1).Value = "Detail Report" & vbCrLf & rs!TaskOrderDesc
        Set C = oSheet.Cells(iRow, 1)
        Range(C.Cells, C.Cells.Offset(0, 1)).Select

        Selection.Merge

        Set C = Selection
        With C
        Call formatItem(C, "Arial", True, 12, 15, _
                xlAutomatic, xlContinuous, _
                xlMedium, xlThin, xlThin, xlMedium, _
                xlMedium, xlThin, True, 54.75, xlTop)
        End With
Set C = oSheet.Cells(iRow, 3)
With C
        Call formatItem(C, "Arial", True, 12, 15, _
                xlAutomatic, xlContinuous, _
                xlMedium, xlThin, xlThin, xlMedium, _
                xlMedium, xlThin, True, 54.75, xlTop)
End With
        iRow = iRow + 1
        TheTO = rs!TaskOrderDesc

    End If

skiped:
 Loop

Open in new window

0
 
LVL 18

Expert Comment

by:SimonAdept
ID: 40585111
Hi Megin, here is a simple example (in Access not Excel)
Sub Megin()
Dim rs As DAO.Recordset
Dim ctr As Integer
Set rs = CurrentDb.OpenRecordset("tbldates") 'use any local tablename that has just a few records in.
rs.MoveLast
rs.MoveFirst
Do Until rs.EOF
 ctr = ctr + 1
 If ctr = 1 Then
 Debug.Print ctr, "Firstrecord"
 ElseIf ctr = rs.RecordCount Then
 Debug.Print ctr, "lastrecord"
 Else
 Debug.Print ctr, "middlerecord"
 End If
 rs.MoveNext
Loop
End Sub

Open in new window


I'm not sure where your code has gone wrong. Your nested IF statements are difficult to follow, and the conditional blocks have become unbalanced. I can't debug it without the rest of the routine and associated ones (formatItem).

Is the nesting really necessary? If you tidy up the indentation levels you may find where it has become unbalanced.
0
 

Author Comment

by:Megin
ID: 40587107
Okay, I am getting an error saying I have "Else without If," but from what I can see I have all of my Ifs in there. Can you take a look? I think I have the set up correct.

Do Until rs.EOF
ctr = ctr + 1

    If rs!TaskOrderDesc = TheTO Then
        If rs!SubTaskDesc = TheSTOname Then
            If TheStaffName = rs!ReportAs Then
                If TheActDesc = rs!ActivityDesc Then
                    rs.MoveNext
                Else
                    TheTypeID = rs!ActivityTypeID
                    If ctr = 1 Then

                        Select Case TheTypeID
                            Case 1
                          
                                oSheet.Cells(iRow, 3).Value = "Participated in meetings:" & vbCrLf & "     * " & rs!ActivityDesc
                                oSheet.Cells(iRow, 3).Font.Size = 10
                                oSheet.Cells(iRow, 3).Font.Name = "Arial"
                                oSheet.Cells(iRow, 3).IndentLevel = 1
                                oSheet.Cells(iRow, 3).WrapText = True
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                                
                            Case 3
                                oSheet.Cells(iRow, 3).Value = "- " & rs!ActivityDesc
                                oSheet.Cells(iRow, 3).Font.Size = 10
                                oSheet.Cells(iRow, 3).Font.Name = "Arial"
                                oSheet.Cells(iRow, 3).IndentLevel = 1
                                oSheet.Cells(iRow, 3).WrapText = True
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                            Case Else
                                oSheet.Cells(iRow, 3).Value = rs!ActivityDesc
'THE PROBLEM IS THIS STATEMENT----------------------------------------------------
                    ElseIf ctr = rs.RecordCount Then
                        Select Case TheTypeID
                          Case 1
                        
                              oSheet.Cells(iRow, 3).Value = "     * " & rs!ActivityDesc
                              oSheet.Cells(iRow, 3).Font.Size = 10
                              oSheet.Cells(iRow, 3).Font.Name = "Arial"
                              oSheet.Cells(iRow, 3).IndentLevel = 1
                              oSheet.Cells(iRow, 3).WrapText = True
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                              
                          Case 3
                              oSheet.Cells(iRow, 3).Value = "- " & rs!ActivityDesc
                              oSheet.Cells(iRow, 3).Font.Size = 10
                              oSheet.Cells(iRow, 3).Font.Name = "Arial"
                              oSheet.Cells(iRow, 3).IndentLevel = 1
                              oSheet.Cells(iRow, 3).WrapText = True
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                        Case Else
                            oSheet.Cells(iRow, 3).Value = rs!ActivityDesc
                    Else
                    Debug.Print ctr, "middlerecord"
                    
                    
                    End If
                    End Select
                End If
                    iRow = iRow + 1
                    rs.MoveNext

Open in new window

0
 

Author Comment

by:Megin
ID: 40587196
Wait! Don't answer that last post.

I was missing the End Select statements.

I still haven't gotten it running yet, but the error is gone.
0
 

Author Comment

by:Megin
ID: 40587226
Okay, I just ran the code and got no errors, however it also didn't put any information into my spreadsheet. The first actdesc was added, but nothing else.
I stepped through the code and it just skips the Select case statements. Here is the code again. I have added the part before the loop starts, just in case that is what is causing the problem:

sql = "q_PMACWeeklyReport"
 Set db = CurrentDb
 Set Qd = db.QueryDefs("q_PMACWeeklyReport")
 
'-----------------------------------------------------------
'Filter Query!!
'-----------------------------------------------------------

Set rs = db.OpenRecordset("select * from q_PMACWeeklyReport where WeeklyReportID = " & RptID, dbOpenDynaset, dbReadOnly)

    rs.MoveLast
    rs.MoveFirst

 If rs.RecordCount = 0 Then
     GoTo Bail
 End If

'------------------------------------------------------------------------
'These row numbers will have to change whenever a new task order is added
'------------------------------------------------------------------------


TheTO = rs!TaskOrderDesc
oSheet.Cells(26, 1).Value = "Detail Report" & vbCrLf & TheTO
Set C = oSheet.Cells(26, 1)
Range(C.Cells, C.Cells.Offset(0, 1)).Select
Selection.Merge
Set C = Selection
With C
    Call formatItem(C, "Arial", True, 12, 15, _
                    xlAutomatic, xlContinuous, _
                    xlMedium, xlMedium, xlThin, xlMedium, _
                    xlMedium, xlThin, True, 54.75, xlTop)
End With


'-------------------------------------------------
'formats cell next to it. just turns it gray
'-------------------------------------------------

Set C = oSheet.Cells(26, 3)
With C
    Call formatItem(C, "Arial", True, 12, 15, _
                    xlAutomatic, xlContinuous, _
                    xlMedium, xlMedium, xlThin, xlMedium, _
                    xlMedium, xlThin, True, 54.75, xlTop)
End With
'------------------------------------------
'STO
'------------------------------------------

TheSTOname = rs!SubTaskDesc
oSheet.Cells(27, 1).Value = TheSTOname
Set C = oSheet.Cells(27, 1)
With C
    Call formatItem(C, "Arial", False, 12, 0, _
                    xlAutomatic, xlContinuous, _
                    xlThin, xlThin, xlThin, xlMedium, _
                    xlThin, xlThin, True, 54.75, xlTop)
End With
'-----------------------------------------
'Staff
'-----------------------------------------

TheStaffName = rs!ReportAs
oSheet.Cells(27, 2).Value = TheStaffName
Set C = oSheet.Cells(27, 2)
With C
    Call formatItem(C, "Arial", False, 12, 0, _
                    xlAutomatic, xlContinuous, _
                    xlThin, xlThin, xlMedium, xlThin, _
                    xlMedium, xlThin, True, 54.75, xlTop)
    
End With
'-------------------------------------------------------
'Description
'-------------------------------------------------------
TheActDesc = rs!ActivityDesc
TheTypeID = rs!ActivityTypeID
Select Case TheTypeID
    Case 1
        oSheet.Cells(27, 3).Value = "     * " & TheActDesc
        oSheet.Cells(27, 3).Font.Name = "Arial"
        oSheet.Cells(27, 3).Font.Size = 10
        oSheet.Cells(27, 3).IndentLevel = 1
        oSheet.Cells(27, 3).WrapText = True
        oSheet.Cells(27, 3).IndentLevel = 1
        oSheet.Cells(27, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
        oSheet.Cells(27, 3).Borders(xlEdgeRight).weight = xlThin
        oSheet.Cells(27, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
        oSheet.Cells(27, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
        oSheet.Cells(27, 3).Borders(xlEdgeLeft).weight = xlThin
        oSheet.Cells(27, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
        oSheet.Cells(27, 3).VerticalAlignment = xlTop
        
    Case 3
        oSheet.Cells(27, 3).Value = "- " & TheActDesc
        oSheet.Cells(27, 3).Font.Name = "Arial"
        oSheet.Cells(27, 3).Font.Size = 10
        oSheet.Cells(27, 3).IndentLevel = 1
        oSheet.Cells(27, 3).Borders(xlEdgeRight).weight = xlThin
        oSheet.Cells(27, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
        oSheet.Cells(27, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
        oSheet.Cells(27, 3).Borders(xlEdgeLeft).weight = xlThin
        oSheet.Cells(27, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
        oSheet.Cells(27, 3).VerticalAlignment = xlTop
    Case Else
        oSheet.Cells(27, 3).Value = TheActDesc
End Select

iRow = 28

rs.MoveNext

iNumCols = 3

'----------------------------------------------------------------------------------------------------------
'THE LOOP STARTS HERE
'----------------------------------------------------------------------------------------------------------

Do Until rs.EOF
ctr = ctr + 1

    If rs!TaskOrderDesc = TheTO Then
        If rs!SubTaskDesc = TheSTOname Then
            If TheStaffName = rs!ReportAs Then
                If TheActDesc = rs!ActivityDesc Then
                    rs.MoveNext
                Else
                If ctr = 1 Then
                    TheTypeID = rs!ActivityTypeID


                        Select Case TheTypeID
                            Case 1
                          
                                oSheet.Cells(iRow, 3).Value = "Participated in meetings:" & vbCrLf & "     * " & rs!ActivityDesc
                                oSheet.Cells(iRow, 3).Font.Size = 10
                                oSheet.Cells(iRow, 3).Font.Name = "Arial"
                                oSheet.Cells(iRow, 3).IndentLevel = 1
                                oSheet.Cells(iRow, 3).WrapText = True
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                                
                            Case 3
                                oSheet.Cells(iRow, 3).Value = "- " & rs!ActivityDesc
                                oSheet.Cells(iRow, 3).Font.Size = 10
                                oSheet.Cells(iRow, 3).Font.Name = "Arial"
                                oSheet.Cells(iRow, 3).IndentLevel = 1
                                oSheet.Cells(iRow, 3).WrapText = True
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                            Case Else
                                oSheet.Cells(iRow, 3).Value = rs!ActivityDesc
                            End Select
                            
                    ElseIf ctr = rs.RecordCount Then
                        Select Case TheTypeID
                          Case 1
                        
                              oSheet.Cells(iRow, 3).Value = "     * " & rs!ActivityDesc
                              oSheet.Cells(iRow, 3).Font.Size = 10
                              oSheet.Cells(iRow, 3).Font.Name = "Arial"
                              oSheet.Cells(iRow, 3).IndentLevel = 1
                              oSheet.Cells(iRow, 3).WrapText = True
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                              
                          Case 3
                              oSheet.Cells(iRow, 3).Value = "- " & rs!ActivityDesc
                              oSheet.Cells(iRow, 3).Font.Size = 10
                              oSheet.Cells(iRow, 3).Font.Name = "Arial"
                              oSheet.Cells(iRow, 3).IndentLevel = 1
                              oSheet.Cells(iRow, 3).WrapText = True
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                        Case Else
                            oSheet.Cells(iRow, 3).Value = rs!ActivityDesc
                        End Select
'
'                    ElseIf ctr > 1 Then
'                        Debug.Print ctr, "middlerecord"
                    
                    

                    'End Select
                End If
                    iRow = iRow + 1
                    rs.MoveNext
                    TheActDesc = ""
                End If
            Else
                oSheet.Cells(iRow, 2).Value = rs!ReportAs
                Set C = oSheet.Cells(iRow, 2)
                    With C
                        Call formatItem(C, "Arial", False, 12, 0, _
                        xlAutomatic, xlContinuous, _
                        xlThin, xlThin, xlMedium, xlThin, _
                        xlMedium, xlThin, True, 54.75, xlTop)
                End With
                TheStaffName = rs!ReportAs
            End If
        Else
            oSheet.Cells(iRow, 1).Value = rs!SubTaskDesc
            Set C = oSheet.Cells(iRow, 1)
            With C
                Call formatItem(C, "Arial", False, 12, 0, _
                        xlAutomatic, xlContinuous, _
                        xlThin, xlThin, xlThin, xlMedium, _
                        xlThin, xlThin, True, 54.75, xlTop)
            End With
            TheSTOname = rs!SubTaskDesc
            TheStaffName = ""
        End If
    Else
        oSheet.Cells(iRow, 1).Value = "Detail Report" & vbCrLf & rs!TaskOrderDesc
        Set C = oSheet.Cells(iRow, 1)
        Range(C.Cells, C.Cells.Offset(0, 1)).Select
        Selection.Merge
        Set C = Selection
        With C
            Call formatItem(C, "Arial", True, 12, 15, _
                    xlAutomatic, xlContinuous, _
                    xlMedium, xlThin, xlThin, xlMedium, _
                    xlMedium, xlThin, True, 54.75, xlTop)
        End With
Set C = oSheet.Cells(iRow, 3)
With C
    Call formatItem(C, "Arial", True, 12, 15, _
            xlAutomatic, xlContinuous, _
            xlMedium, xlThin, xlThin, xlMedium, _
            xlMedium, xlThin, True, 54.75, xlTop)
End With
        iRow = iRow + 1
        TheTO = rs!TaskOrderDesc

    End If

skiped:
 Loop

Open in new window

0
 
LVL 18

Expert Comment

by:SimonAdept
ID: 40587254
Ok, this now compiles. It was missing an 'END SELECT' line and possibly I've reordered some other bits. You'll need to check very carefully that it does what you want.

Sub megin2
Do Until rs.EOF
ctr = ctr + 1

    If rs!TaskOrderDesc = TheTO Then
        If rs!SubTaskDesc = TheSTOname Then
            If TheStaffName = rs!ReportAs Then
                If TheActDesc = rs!ActivityDesc Then
                    rs.MoveNext
                Else
                    TheTypeID = rs!ActivityTypeID
                    If ctr = 1 Then '******* First record in recordset *******

                        Select Case TheTypeID
                            Case 1
                          
                                oSheet.Cells(iRow, 3).Value = "Participated in meetings:" & vbCrLf & "     * " & rs!ActivityDesc
                                oSheet.Cells(iRow, 3).Font.Size = 10
                                oSheet.Cells(iRow, 3).Font.Name = "Arial"
                                oSheet.Cells(iRow, 3).IndentLevel = 1
                                oSheet.Cells(iRow, 3).WrapText = True
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).Weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).Weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                                
                            Case 3
                                oSheet.Cells(iRow, 3).Value = "- " & rs!ActivityDesc
                                oSheet.Cells(iRow, 3).Font.Size = 10
                                oSheet.Cells(iRow, 3).Font.Name = "Arial"
                                oSheet.Cells(iRow, 3).IndentLevel = 1
                                oSheet.Cells(iRow, 3).WrapText = True
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).Weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).Weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                            Case Else
                                oSheet.Cells(iRow, 3).Value = rs!ActivityDesc
                             End Select
                    ElseIf ctr = rs.RecordCount Then '******* Last record in recordset *******
                        Select Case TheTypeID
                          Case 1
                              oSheet.Cells(iRow, 3).Value = "     * " & rs!ActivityDesc
                              oSheet.Cells(iRow, 3).Font.Size = 10
                              oSheet.Cells(iRow, 3).Font.Name = "Arial"
                              oSheet.Cells(iRow, 3).IndentLevel = 1
                              oSheet.Cells(iRow, 3).WrapText = True
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).Weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).Weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                              
                          Case 3
                              oSheet.Cells(iRow, 3).Value = "- " & rs!ActivityDesc
                              oSheet.Cells(iRow, 3).Font.Size = 10
                              oSheet.Cells(iRow, 3).Font.Name = "Arial"
                              oSheet.Cells(iRow, 3).IndentLevel = 1
                              oSheet.Cells(iRow, 3).WrapText = True
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).Weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).Weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                        Case Else
                            oSheet.Cells(iRow, 3).Value = rs!ActivityDesc
                    
                    Debug.Print ctr, "middlerecord"
                    
                    End Select
                Else
                'do stuff for the intermediate records
                End If
                
                iRow = iRow + 1
                rs.MoveNext
                    
            End If
        End If
    End If
  End If
Loop
End Sub

Open in new window

0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 18

Expert Comment

by:SimonAdept
ID: 40587295
Doh! Our posts crossed.

I can't do any more on this unless you post a self-contained example (i.e. the database and/or workbook)

>I stepped through the code and it just skips the Select case statements.
Glad you're stepping through it. You need to set watches and/or breakpoints to check the variable values while stepping to see WHY it is skipping the select case statements.
0
 

Author Comment

by:Megin
ID: 40587503
I think that the ctr is not counting what I want it to count.

When I check it, it is saying there are 244 records. That is the total number of records returned from the query.

But for the purposes of the formatting, I think it needs to only count the number of ActivityDesc records per ReportAs records.

I am attaching a picture of what the report should look like.

I think that, rather than counting just the items that would appear between rows 2 and 4 (in the image), it is counting all of the rows in column C.

Of course, this is all in Excel speak and I am running this code from Access. The access code exports the data from a query into an Excel spreadsheet.

(I am going to stop typing now because I think I am making it more complicated than it is!)
Publication1.jpg
0
 
LVL 18

Expert Comment

by:SimonAdept
ID: 40587629
If you move line 3 of the above listing ('ctr = ctr + 1') to a new line after the 'Else' on line 11, you'll only count the records you're interested in.
Sub megin3
Do Until rs.EOF
    If rs!TaskOrderDesc = TheTO Then
        If rs!SubTaskDesc = TheSTOname Then
            If TheStaffName = rs!ReportAs Then
                If TheActDesc = rs!ActivityDesc Then
                    rs.MoveNext
                Else
                    ctr = ctr + 1 ' only increment counter for 'ActivityDesc' records to be included
                    TheTypeID = rs!ActivityTypeID
                    If ctr = 1 Then '******* First record in recordset *******

                        Select Case TheTypeID
                            Case 1
                          
                                oSheet.Cells(iRow, 3).Value = "Participated in meetings:" & vbCrLf & "     * " & rs!ActivityDesc
                                oSheet.Cells(iRow, 3).Font.Size = 10
                                oSheet.Cells(iRow, 3).Font.Name = "Arial"
                                oSheet.Cells(iRow, 3).IndentLevel = 1
                                oSheet.Cells(iRow, 3).WrapText = True
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).Weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).Weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                                
                            Case 3
                                oSheet.Cells(iRow, 3).Value = "- " & rs!ActivityDesc
                                oSheet.Cells(iRow, 3).Font.Size = 10
                                oSheet.Cells(iRow, 3).Font.Name = "Arial"
                                oSheet.Cells(iRow, 3).IndentLevel = 1
                                oSheet.Cells(iRow, 3).WrapText = True
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).Weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).Weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                            Case Else
                                oSheet.Cells(iRow, 3).Value = rs!ActivityDesc
                             End Select
                    ElseIf ctr = rs.RecordCount Then '******* Last record in recordset *******
                        Select Case TheTypeID
                          Case 1
                              oSheet.Cells(iRow, 3).Value = "     * " & rs!ActivityDesc
                              oSheet.Cells(iRow, 3).Font.Size = 10
                              oSheet.Cells(iRow, 3).Font.Name = "Arial"
                              oSheet.Cells(iRow, 3).IndentLevel = 1
                              oSheet.Cells(iRow, 3).WrapText = True
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).Weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).Weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                              
                          Case 3
                              oSheet.Cells(iRow, 3).Value = "- " & rs!ActivityDesc
                              oSheet.Cells(iRow, 3).Font.Size = 10
                              oSheet.Cells(iRow, 3).Font.Name = "Arial"
                              oSheet.Cells(iRow, 3).IndentLevel = 1
                              oSheet.Cells(iRow, 3).WrapText = True
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).Weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).Weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                        Case Else
                            oSheet.Cells(iRow, 3).Value = rs!ActivityDesc
                    
                    Debug.Print ctr, "middlerecord"
                    
                    End Select
                Else
                'do stuff for the intermediate records
                End If
                
                iRow = iRow + 1
                rs.MoveNext
                    
            End If
        End If
    End If
  End If
Loop
End Sub

Open in new window

0
 

Author Comment

by:Megin
ID: 40589651
It worked better! But it isn't resetting the count the next time it goes through. So the very first record gets put in just fine, with the correct formatting. And the second record does, too. But then it never applies the formatting for the first record again.

I tried setting ctr = 0 after the last End If and that just make it so that it thought that every time was the first time.

It seems like that is the direction to go in, though. But I don't know where to put it in the code.

Am I on the right path with this? Am I completely wrong?
0
 
LVL 18

Expert Comment

by:SimonAdept
ID: 40589681
It's really difficult to tell without having a self-contained example that includes code and the dataset it operates on.
. Your screenshot went some way to help us visualise what you're doing, but it would help so much more to see the recordset data.

Your might need to reset ctr=0 at after each 'End If' in lines 83-86 of the listing immediately above,
or, thinking about it, immediately after processing the last row (the case where the ctr = the recordcount)

i.e. at the end of this elseif clause
ElseIf ctr = rs.RecordCount Then '******* Last record in recordset *******

To make further progress, either post some more material for us to work with or spend some time yourself stepping through the code and setting breakpoints and watches that break when the watched value changes. That's the way to see what is actually happening.
0
 

Author Comment

by:Megin
ID: 40589860
I am going to try to make a blank copy of the database so I can share it. Right now it has thousands of records and several linked tables.

In the meantime, I will look through what you just sent and try some more.
0
 

Author Comment

by:Megin
ID: 40590023
Okay!

Attached is a copy of my database with all of the reports and forms gone except for the one form that runs the code I am working on. The code Exports data from the database into an Excel spreadsheet.

Just pick the one date from the drop-down menu and run the report.

Thank you for the help!!!
For-Experts-Exchange.accdb
0
 
LVL 18

Accepted Solution

by:
SimonAdept earned 500 total points
ID: 40591010
Hi Megin,

See if this example output is what you wanted.
MeginReport.xlsx
 If so, try this code:
Option Compare Database
Option Explicit

Private Sub btnExportWklyReport_Click()


On Error GoTo Error_Handler

 Dim db As Database
 Dim rs As Recordset
 Dim iW As Integer
 Dim iRow As Integer
 Dim oApp As Excel.Application
 Dim oBook As Excel.Workbook
 Dim oSheet As Excel.Worksheet
 Dim oRange As Excel.Range
 Dim i As Integer
 Dim iNumCols As Integer
 Dim TheTO As String
 Dim TheSTOname As String
 Dim TheStaffName As String
 Dim TheActDesc As String
 Dim C As Excel.Range
 Dim Qd As QueryDef
 Dim TheTypeID As Integer
 Dim sql As String
 Dim w As Integer
 Dim ctr As Integer
 Dim rsRowsCount As Integer 'Store the size of the recordset in a variable to save counting it repeatedly
 
 
 Set oApp = Excel.Application


 sql = ""
 iW = 0
 iRow = 0
 i = 0
 iNumCols = 0
 TheTO = ""
 TheSTOname = ""
 TheStaffName = ""
 TheActDesc = ""

 
 
 Set oBook = oApp.Workbooks.Add
 Set oSheet = oBook.Worksheets(1)
 With oSheet.PageSetup

  
    .Orientation = xlLandscape
    .LeftMargin = oApp.InchesToPoints(0.25)
    .RightMargin = oApp.InchesToPoints(0.25)
    .TopMargin = oApp.InchesToPoints(0.5)
    .BottomMargin = oApp.InchesToPoints(0.5)
    .HeaderMargin = oApp.InchesToPoints(0.5)
    .FooterMargin = oApp.InchesToPoints(0.16)
    .PaperSize = xlPaperLetter
    .CenterHorizontally = False
    .CenterVertically = False
    .FitToPagesWide = 1
    .FitToPagesTall = False
    .Zoom = False
       

End With
    
oApp.Visible = True
oApp.UserControl = True
 
Set db = CurrentDb
Set Qd = db.QueryDefs("q_r_TO_PMACReport")
Set rs = Qd.OpenRecordset(dbOpenDynaset, dbReadOnly)
 rs.MoveLast
 rs.MoveFirst
 rsRowsCount = rs.RecordCount   '5/2/15 - added by EE-SA
 Debug.Print rsRowsCount        '5/2/15 - added by EE-SA
If rsRowsCount = 0 Then
    GoTo Bail
End If
 
iNumCols = IIf(w > 0, w, iNumCols)
 'Format the header row as bold
oSheet.Range("a1").Select
With Selection
    .Columns("A:A").ColumnWidth = 46.2
    .Columns("B:B").ColumnWidth = 32.57
    .Columns("C:C").ColumnWidth = 73.43
End With

'---------------------------------------------------------------------------------------------
'Enters information in the report header, merges the cell with the one next to it, and formats
'---------------------------------------------------------------------------------------------

oSheet.Cells(1, 1).Value = "Title" & vbCrLf & "Weekly Activity Report"
Set C = oSheet.Cells(1, 1)
Range(C.Cells, C.Cells.Offset(0, 1)).Select
Selection.Merge
Set C = Selection
With C
    Call FormatHeader _
    (C, True, 18, "Arial", True, xlCenter, xlBottom, 69, _
    xlContinuous, xlContinuous, xlContinuous, xlContinuous, xlNone, xlNone, _
    xlMedium, xlMedium, xlMedium, xlMedium, xlMedium, xlMedium, xlAutomatic, xlAutomatic, xlAutomatic)
    
End With

oSheet.Cells(1, 3).Value = "No. " & rptNO
Set C = oSheet.Cells(1, 3)
With C
    Call FormatHeader _
    (C, True, 12, "Arial", False, xlCenter, xlBottom, 69, _
    xlContinuous, xlNone, xlContinuous, xlContinuous, xlNone, xlNone, _
    xlMedium, xlMedium, xlMedium, xlMedium, xlMedium, xlMedium, xlAutomatic, xlAutomatic, 0)
End With

 oSheet.Cells(2, 1).Value = "Task Order/Sub Tasks"
 Set C = oSheet.Cells(2, 1)
 With C
    Call FormatHeader _
    (C, True, 14, "Arial", False, xlCenter, xlBottom, 29.25, _
    xlContinuous, xlContinuous, xlContinuous, xlContinuous, xlNone, xlNone, _
    xlMedium, xlMedium, xlMedium, xlThin, xlMedium, xlMedium, xlAutomatic, xlAutomatic, xlAutomatic)
End With

oSheet.Cells(2, 2).Value = "Staff"
Set C = oSheet.Cells(2, 2)
With C
    Call FormatHeader _
    (C, True, 14, "Arial", False, xlCenter, xlBottom, 29.25, _
    xlContinuous, xlContinuous, xlContinuous, xlContinuous, xlNone, xlNone, _
    xlMedium, xlMedium, xlMedium, xlThin, xlMedium, xlMedium, xlAutomatic, xlAutomatic, xlAutomatic)
End With


oSheet.Cells(2, 3).Value = "Week Ending" & " " & reportdate
Set C = oSheet.Cells(2, 3)
With C
     Call FormatHeader _
     (C, True, 12, "Arial", False, xlCenter, xlBottom, 29.25, _
     xlNone, xlContinuous, xlContinuous, xlContinuous, xlNone, xlNone, _
     xlMedium, xlMedium, xlMedium, xlMedium, xlMedium, xlMedium, xlAutomatic, 0, xlAutomatic)
End With

'-----------------------------------------------------------------------
'Main header is now done. Now it is time to fill in that first gray row.
'-----------------------------------------------------------------------

oSheet.Cells(3, 1).Value = "Summary Report"
Set C = oSheet.Cells(3, 1)
Range(C.Cells, C.Cells.Offset(0, 1)).Select
Selection.Merge
Set C = Selection
With C
    Call TopGrayBar(C, "Arial", True, 12, 15, xlDouble, _
                    xlContinuous, xlContinuous, xlContinuous, _
                    xlMedium, xlMedium, xlAutomatic, True, _
                    54.75, xlMedium, xlMedium, xlLeft, xlCenter)
End With

Set C = oSheet.Cells(3, 3)
With C
    Call TopGrayBar(C, "Arial", True, 12, 15, xlDouble, _
                    xlContinuous, xlContinuous, xlContinuous, _
                    xlMedium, xlMedium, xlAutomatic, True, _
                    54.75, xlMedium, xlMedium, xlLeft, xlCenter)
End With
    
'-------------------------------------------------------------------------------------------------
'Now start entering the full task order section. This next piece of code adds the first task order.
'-------------------------------------------------------------------------------------------------


TheTO = rs!TaskOrderDesc
oSheet.Cells(4, 1).Value = TheTO
Set C = oSheet.Cells(4, 1)
Range(C.Cells, C.Cells.Offset(0, 1)).Select
Selection.Merge
Set C = Selection
With C
    Call FormatTheCell(C, "Arial", True, 12, True, 50, _
                       xlGeneral, xlCenter, xlAutomatic, _
                       xlContinuous, xlThin, xlThin, xlMedium, _
                       xlMedium, xlAutomatic, xlMedium, xlMedium)
End With

'-----------------------------------------------------------
'format cell next to it
'-----------------------------------------------------------

Range(C.Cells, C.Cells.Offset(0, 1)).Select
Set C = Selection
With C
    Call FormatTheCell(C, "Arial", True, 12, True, 50, _
                       xlGeneral, xlCenter, xlAutomatic, _
                       xlContinuous, xlThin, xlThin, xlMedium, _
                       xlMedium, xlAutomatic, xlMedium, xlMedium)
End With

'-----------------------------------------------------------
'Start 5 rows down
'-----------------------------------------------------------

iRow = 5
Do Until rs.EOF

'-----------------------------------------------------------
'If the TO matches what is already there, go to the next TO
'-----------------------------------------------------------

If rs!TaskOrderDesc = TheTO Then
    rs.MoveNext
Else

'-----------------------------------------------------------
'If it doesn't match, then start writing them into the cells
'-----------------------------------------------------------

oSheet.Cells(iRow, 1).Value = rs!TaskOrderDesc

TheTO = rs!TaskOrderDesc

Set C = oSheet.Cells(iRow, 1)
Range(C.Cells, C.Cells.Offset(0, 1)).Select
Selection.Merge
Set C = Selection
With C
    Call FormatTheCell(C, "Arial", True, 12, True, 50, _
                       xlGeneral, xlCenter, xlAutomatic, _
                       xlContinuous, xlThin, xlThin, xlMedium, _
                       xlMedium, xlAutomatic, xlMedium, xlMedium)
End With

'---------------------------------------------------------------
'Format cells next door.
'---------------------------------------------------------------

Set C = oSheet.Cells(iRow, 1)
Range(C.Cells, C.Cells.Offset(0, 1)).Select
Set C = Selection
With C
    Call FormatTheCell(C, "Arial", True, 12, True, 50, _
                       xlGeneral, xlCenter, xlAutomatic, _
                       xlContinuous, xlThin, xlThin, xlMedium, _
                       xlMedium, xlAutomatic, xlMedium, xlMedium)
End With

iRow = iRow + 1
        
End If
skip:
Loop

 sql = "q_PMACWeeklyReport"
 Set db = CurrentDb
 Set Qd = db.QueryDefs("q_PMACWeeklyReport")
 
'-----------------------------------------------------------
'Filter Query!!
'-----------------------------------------------------------

Set rs = db.OpenRecordset("select * from q_PMACWeeklyReport where WeeklyReportID = " & RptID, dbOpenDynaset, dbReadOnly)

    rs.MoveLast
    rs.MoveFirst
    rsRowsCount = rs.RecordCount
    Debug.Print rsRowsCount
 If rs.RecordCount = 0 Then
     GoTo Bail
 End If

'------------------------------------------------------------------------
'These row numbers will have to change whenever a new task order is added
'------------------------------------------------------------------------


TheTO = rs!TaskOrderDesc
oSheet.Cells(26, 1).Value = "Detail Report" & vbCrLf & TheTO
Set C = oSheet.Cells(26, 1)
Range(C.Cells, C.Cells.Offset(0, 1)).Select
Selection.Merge
Set C = Selection
With C
    Call formatItem(C, "Arial", True, 12, 15, _
                    xlAutomatic, xlContinuous, _
                    xlMedium, xlMedium, xlThin, xlMedium, _
                    xlMedium, xlThin, True, 54.75, xlTop)
End With


'-------------------------------------------------
'formats cell next to it. just turns it gray
'-------------------------------------------------

Set C = oSheet.Cells(26, 3)
With C
    Call formatItem(C, "Arial", True, 12, 15, _
                    xlAutomatic, xlContinuous, _
                    xlMedium, xlMedium, xlThin, xlMedium, _
                    xlMedium, xlThin, True, 54.75, xlTop)
End With
'------------------------------------------
'STO
'------------------------------------------

TheSTOname = rs!SubTaskDesc
oSheet.Cells(27, 1).Value = TheSTOname
Set C = oSheet.Cells(27, 1)
With C
    Call formatItem(C, "Arial", False, 12, 0, _
                    xlAutomatic, xlContinuous, _
                    xlThin, xlThin, xlThin, xlMedium, _
                    xlThin, xlThin, True, 54.75, xlTop)
End With
'-----------------------------------------
'Staff
'-----------------------------------------

TheStaffName = rs!ReportAs
oSheet.Cells(27, 2).Value = TheStaffName
Set C = oSheet.Cells(27, 2)
With C
    Call formatItem(C, "Arial", False, 12, 0, _
                    xlAutomatic, xlContinuous, _
                    xlThin, xlThin, xlMedium, xlThin, _
                    xlMedium, xlThin, True, 54.75, xlTop)
    
End With
'-------------------------------------------------------
'Description
'-------------------------------------------------------
'TheActDesc = rs!ActivityDesc
'TheTypeID = rs!ActivityTypeID
'Select Case TheTypeID
'    Case 1
'        oSheet.Cells(27, 3).Value = "     * " & TheActDesc
'        oSheet.Cells(27, 3).Font.Name = "Arial"
'        oSheet.Cells(27, 3).Font.Size = 10
'        oSheet.Cells(27, 3).IndentLevel = 1
'        oSheet.Cells(27, 3).WrapText = True
'        oSheet.Cells(27, 3).IndentLevel = 1
'        oSheet.Cells(27, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
'        oSheet.Cells(27, 3).Borders(xlEdgeRight).weight = xlThin
'        oSheet.Cells(27, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
'        oSheet.Cells(27, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
'        oSheet.Cells(27, 3).Borders(xlEdgeLeft).weight = xlThin
'        oSheet.Cells(27, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
'        oSheet.Cells(27, 3).VerticalAlignment = xlTop
'
'    Case 3
'        oSheet.Cells(27, 3).Value = "- " & TheActDesc
'        oSheet.Cells(27, 3).Font.Name = "Arial"
'        oSheet.Cells(27, 3).Font.Size = 10
'        oSheet.Cells(27, 3).IndentLevel = 1
'        oSheet.Cells(27, 3).Borders(xlEdgeRight).weight = xlThin
'        oSheet.Cells(27, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
'        oSheet.Cells(27, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
'        oSheet.Cells(27, 3).Borders(xlEdgeLeft).weight = xlThin
'        oSheet.Cells(27, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
'        oSheet.Cells(27, 3).VerticalAlignment = xlTop
'    Case Else
'        oSheet.Cells(27, 3).Value = TheActDesc
'End Select

iRow = 27

rs.MoveNext

iNumCols = 3


rs.MoveLast
rs.MoveFirst

Do Until rs.EOF


    If rs!TaskOrderDesc = TheTO Then
        If rs!SubTaskDesc = TheSTOname Then
            If TheStaffName = rs!ReportAs Then
                If TheActDesc = rs!ActivityDesc Then
                    rs.MoveNext
                Else
                    ctr = ctr + 1
                    Debug.Print ctr
                    TheTypeID = rs!ActivityTypeID
                    If ctr = 1 Then                 '**** First record ****
                        Select Case TheTypeID
                            Case 1
                                oSheet.Cells(iRow, 3).Value = "Participated in meetings:" & vbCrLf & "     * " & rs!ActivityDesc
                                oSheet.Cells(iRow, 3).Font.Size = 10
                                oSheet.Cells(iRow, 3).Font.Name = "Arial"
                                oSheet.Cells(iRow, 3).IndentLevel = 1
                                oSheet.Cells(iRow, 3).WrapText = True
                                oSheet.Cells(iRow, 3).Borders(xlEdgeTop).weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                                
                            Case 3
                                oSheet.Cells(iRow, 3).Value = "- " & rs!ActivityDesc
                                oSheet.Cells(iRow, 3).Font.Size = 10
                                oSheet.Cells(iRow, 3).Font.Name = "Arial"
                                oSheet.Cells(iRow, 3).IndentLevel = 1
                                oSheet.Cells(iRow, 3).WrapText = True
                                oSheet.Cells(iRow, 3).Borders(xlEdgeTop).weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                                oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                                oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                            Case Else
                                oSheet.Cells(iRow, 3).Value = rs!ActivityDesc
                                oSheet.Cells(iRow, 3).Borders(xlEdgeTop).weight = xlMedium
                            End Select
                            
                    ElseIf ctr = rsRowsCount Then
                            oSheet.Cells(iRow, 3).Value = "Last Row"
                            
                    ElseIf ctr > 1 Then
                        Select Case TheTypeID
                          Case 1
                        
                              oSheet.Cells(iRow, 3).Value = "     * " & rs!ActivityDesc
                              oSheet.Cells(iRow, 3).Font.Size = 10
                              oSheet.Cells(iRow, 3).Font.Name = "Arial"
                              oSheet.Cells(iRow, 3).IndentLevel = 1
                              oSheet.Cells(iRow, 3).WrapText = True
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                              
                          Case 3
                              oSheet.Cells(iRow, 3).Value = "- " & rs!ActivityDesc
                              oSheet.Cells(iRow, 3).Font.Size = 10
                              oSheet.Cells(iRow, 3).Font.Name = "Arial"
                              oSheet.Cells(iRow, 3).IndentLevel = 1
                              oSheet.Cells(iRow, 3).WrapText = True
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeRight).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).weight = xlMedium
                              oSheet.Cells(iRow, 3).Borders(xlEdgeLeft).ColorIndex = xlAutomatic
                              oSheet.Cells(iRow, 3).VerticalAlignment = xlTop
                        Case Else
                            oSheet.Cells(iRow, 3).Value = rs!ActivityDesc
                        End Select
'
'                    ElseIf ctr > 1 Then
'                        Debug.Print ctr, "middlerecord"
                    
                    

                    'End Select
                End If
                    iRow = iRow + 1
                    rs.MoveNext
                    TheActDesc = ""
                End If
                'Debug.Print ctr

            Else
            ctr = 0 '5/2/15 - added by EE-SA
                oSheet.Cells(iRow, 2).Value = rs!ReportAs
                Set C = oSheet.Cells(iRow, 2)
                    With C
                        Call formatItem(C, "Arial", False, 12, 0, _
                        xlAutomatic, xlContinuous, _
                        xlThin, xlThin, xlMedium, xlThin, _
                        xlMedium, xlThin, True, 54.75, xlTop)
                End With
                TheStaffName = rs!ReportAs
            End If
            'ctr = 1
        Else
            ctr = 0 '5/2/15 - added by EE-SA
            oSheet.Cells(iRow, 1).Value = rs!SubTaskDesc
            Set C = oSheet.Cells(iRow, 1)
            With C
                Call formatItem(C, "Arial", False, 12, 0, _
                        xlAutomatic, xlContinuous, _
                        xlThin, xlThin, xlThin, xlMedium, _
                        xlThin, xlThin, True, 54.75, xlTop)
            End With
            TheSTOname = rs!SubTaskDesc
            TheStaffName = ""
        End If
    Else
        ctr = 0 '5/2/15 - added by EE-SA
        oSheet.Cells(iRow, 1).Value = "Detail Report" & vbCrLf & rs!TaskOrderDesc
        Set C = oSheet.Cells(iRow, 1)
        Range(C.Cells, C.Cells.Offset(0, 1)).Select
        Selection.Merge
        Set C = Selection
        With C
            Call formatItem(C, "Arial", True, 12, 15, _
                    xlAutomatic, xlContinuous, _
                    xlMedium, xlThin, xlThin, xlMedium, _
                    xlMedium, xlThin, True, 54.75, xlTop)
        End With
Set C = oSheet.Cells(iRow, 3)
With C
    Call formatItem(C, "Arial", True, 12, 15, _
            xlAutomatic, xlContinuous, _
            xlMedium, xlThin, xlThin, xlMedium, _
            xlMedium, xlThin, True, 54.75, xlTop)
End With
        iRow = iRow + 1
        TheTO = rs!TaskOrderDesc

    End If

skiped:
 Loop

'-------------------------------------------------------------------------------------------------------------
'Make sure all the text in the C column after the header is not bold and the font is Arial and the indent is 1
'-------------------------------------------------------------------------------------------------------------


Set C = oSheet.Cells.Range("C4:C500")
With C
    .Font.Bold = False
    .Font.Name = "Arial"
    .IndentLevel = 1
    
End With

'------------------------------------------------------------------------
'Errors
'------------------------------------------------------------------------

Bail:
     rs.Close
      Set rs = Nothing
      Qd.Close
      Set Qd = Nothing
      db.Close
      Set db = Nothing
      Set C = Nothing
      Set oRange = Nothing
      Set oSheet = Nothing
      Set oBook = Nothing
      Set oApp = Nothing
Exit Sub
     
Error_Handler:
     MsgBox Error$
     Resume Bail
   
 End Sub

Open in new window


I basically reset the ctr variable to 0 in the ELSE statements so that it started again for each person. The other thing to note is that in the way your programme logic works, there won't be a 'final' loop as the recordset encompasses multiple 'sets' of activities. So, I've formatted the TOP of the initial record (where ctr=1) rather than the last record.

Hope this makes sense to you. Ask if not.

Another possible approach to this report would be do do it in one or two Access reports with grouping levels, but I don't know if that's suitable for your particular requirements.
0
 

Author Closing Comment

by:Megin
ID: 40591633
So, I wish I could give you 1000 points for this, because it is working great!

I see what you did with the ctr = 0 after all of the Else statements.  I wouldn't have thought to put it in more than once.

Also, the formatting the top of the initial record suits my purposes perfectly! I hadn't thought about doing it that way, but it is much simpler than what I had in mind!

I do have a question: How does the code know what ctr is? It is declared as a variable, but then it isn't set to any value to begin with. How is that working?

Thank you so, so, so much for all of your help!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
0
 
LVL 18

Expert Comment

by:SimonAdept
ID: 40591650
>I do have a question: How does the code know what ctr is?
Dim ctr As Integer (at the top of the routine)
Because ctr is declared as an integer, it has a default value of zero, so it equals 1 after the first instance of
ctr=ctr+1
It would have been best practice to explicitly set its initial value. Feel free to add it ;)
0
 

Author Comment

by:Megin
ID: 40591693
I think I got it. So, ctr isn't looking at row count. It is just looking at how many times that particular piece of code has been looped through?
0
 
LVL 18

Expert Comment

by:SimonAdept
ID: 40591826
Pretty much... ctr is just an integer variable that you control the value of by incrementing or setting back to zero.
It is being incremented each time the code executes the branch of the conditional that we're interested in.
0
 

Author Comment

by:Megin
ID: 40594041
I should have also said thank you for working it out so I don't need to put down that first line of description separately. I didn't know I could do it the way you set it up.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Most if not all databases provide tools to filter data; even simple mail-merge programs might offer basic filtering capabilities. This is so important that, although Access has many built-in features to help the user in this task, developers often n…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now