[AccessD] Automated Grouping

I couldn't find a solution to this anywhere on the Net, so I worked out 
one for myself, which is always more satisfying anyway. I'm posting it 
here in case it can help anyone.

I wanted to group (as in Group and Outline) all of the data in all of the 
worksheets in a workbook. The grouping would be based on column A, 
starting in row 2 (allowing for one row of headers). I have several sheets 
of hundreds or thousands (depending on the sheet) of rows, so doing this 
by hand was extremely time-consuming (and painful on the wrist using the 
mouse).

Perhaps this is too elementary for this list, but I thought someone might 
find it useful.

Thomas F. Ewald
FCS Database Manager
General Dynamics Land Systems
(586) 276-1256

--------------------------------------------------------------------------------

Sub AutoGroup()
'Created 10/04/06 by Thomas F. Ewald, GDLS

    Dim intFirstRow As Integer
    Dim intLastRow As Integer
    Dim Wks As Worksheet
    Dim strName As String

    For Each Wks In Worksheets
        Wks.Select
        intFirstRow = 0
 
        Range("A2").Select
 
        Do Until ActiveCell.Value = 0
 
            If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
                'First Match
                If intFirstRow = 0 Then intFirstRow = ActiveCell.Row + 1
                'If not the first match, do nothing. Continue on.
            Else
                'If intFirstRow is not 0, and the next cell does not 
match,
                'we've reached the end of the group. Create the group.
                If intFirstRow <> 0 Then
                    intLastRow = ActiveCell.Row
                    Rows(intFirstRow & ":" & intLastRow).Select
                    Selection.Rows.Group
                    intFirstRow = 0
                    Range("A" & intLastRow).Select
                End If
                'If intFirstRow = 0, and the next cell does not match, 
this
                'cell is unmatched, and there is no group. Continue on.
 
            End If
 
            ActiveCell.Offset(1, 0).Select
 
        Loop
 
    Next Wks
 
End Sub




This is an e-mail from General Dynamics Land Systems. It is for the intended recipient only and may contain confidential and privileged information.  No one else may read, print, store, copy, forward or act in reliance on it or its attachments.  If you are not the intended recipient, please return this message to the sender and delete the message and any attachments from your computer. Your cooperation is appreciated.