[AccessD] Automated Grouping

Useful stuff, Thanks
Jim Hale

-----Original Message-----
From: ewaldt at gdls.com [mailto:ewaldt at gdls.com]
Sent: Wednesday, October 04, 2006 3:53 PM
To: accessd at databaseadvisors.com
Subject: [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.

-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com

***********************************************************************
The information transmitted is intended solely for the individual or
entity to which it is addressed and may contain confidential and/or
privileged material. Any review, retransmission, dissemination or
other use of or taking action in reliance upon this information by
persons or entities other than the intended recipient is prohibited.
If you have received this email in error please contact the sender and
delete the material from any computer. As a recipient of this email,
you are responsible for screening its contents and the contents of any
attachments for the presence of viruses. No liability is accepted for
any damages caused by any virus transmitted by this email.