Auto Outline Dataset in Excel

I am wanting to create an Auto outline macro in Excel for a data set. See the dataset in Sheet1 of the attached file. I want the code to be able to got through that dataset and each time it "reads" the word "Total", group the rows above it. An example of the dataset is in Sheet1 and an example of the desired output is in Sheet2.

Let know if any addtional clarification is needed.

Any takers?

Thanks,
EE-Example.xlsm
ctownsen80Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

nutschCommented:
This macro should work

Thomas
Sub AutoOutline_Total_Lines()
Dim cl As range, rng As range, intIndent As Long, i As Long
Dim rowStart As Long
Dim lastRow As Long 'define variables

application.ScreenUpdating = False

lastRow = range("A" & Rows.Count).End(xlUp).Row 'get last row

With ActiveSheet.Outline
    .AutomaticStyles = False
    .SummaryRow = xlBelow
    .SummaryColumn = xlRight
End With

rowStart = 7

For i = 2 To lastRow
    If Cells(i, "B") = "Total" Then
        Rows(rowStart & ":" & i - 1).Group
        rowStart = i + 1
    End If
Next

application.ScreenUpdating = True

End Sub

Open in new window

0
nutschCommented:
And this one is a more elegant / faster way of achieving the same thing.

Sub AutoOutline_Total_Lines()
Dim rgArea As range, rgData As range

application.ScreenUpdating = False

Set rgData = range("A7").CurrentRegion

With ActiveSheet.Outline
    .AutomaticStyles = False
    .SummaryRow = xlBelow
    .SummaryColumn = xlRight
End With

With rgData
    .AutoFilter
    .AutoFilter 2, "<>Total"
    
    With .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        For Each rgArea In .Areas
            rgArea.EntireRow.Group
        Next rgArea
    End With
    
    .AutoFilter
End With

application.ScreenUpdating = True

End Sub

Open in new window


Thomas
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ScriptAddictCommented:
If you have formulas then you can use the auto outline feature.  Excel uses the formula's to create the auto outline.  That said I don't believe that an auto outline is going to work for your purposes unless you have formula's built into your spreadsheet.

If you are going to use just text data/totals, then you will need to just use standard vba code.  

I've tossed together this VBA code block that should do what you want.  It is designed to start grouping on row eight.

Sub Total()
ptr = 8
Nextnt:
   nt = Cells.Find(What:="Total", After:=Cells(ptr, 1), LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Row
    If nt < ptr Then GoTo Done
    Range(Cells(ptr, 1), Cells(nt - 1, 1)).Select
    Selection.Rows.Group
    ptr = nt + 1
GoTo Nextnt
Done:
End Sub

Open in new window

0
ctownsen80Author Commented:
Worked Like a Charm! Thank you very much.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Programming

From novice to tech pro — start learning today.