Consulting

Results 1 to 4 of 4

Thread: Macro an Outline based on value o:

  1. #1

    Question Macro an Outline based on value o:

    Hi,
    First I'd like to apologize in advance for my "noob-ness," in all honesty I don't know a whole lot about VBA, but that's why I came here to seek help (:

    Is there any way I can make a macro that automatically creates an outline based on a cell's value in that row? I'm working with excel 2003, and I have a whole lot of data that's been imported in a "tree like" hierarchy. It's color coded, but the auto-outline feature doesn't seem to outline it quite right. There is a column called Level that indicates the level in the tree of the item from 0 to 8. Is there a way I can use this, or the color of the row, to automatically group items and create an outline?

    Any help would be appreciated. Thank you very much.

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Can you post you workbook, preferably with an example of how it should look.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    Here is an example of what I would like it to look like.
    The fact is it took me a long time to set this up, and I'd like to find a way to macro it and make it much easier.
    Attached Files Attached Files

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Try this

    [vba]

    Public Function SetOutlines()
    Dim vecCIs As Variant
    Dim Lastrow As Long
    Dim i As Long

    vecCIs = Array(xlColorIndexNone, 15, 20, 37, 47, 0)
    With ActiveSheet

    Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

    Call OutlineRows(ActiveSheet, 3, Lastrow, vecCIs, 1)
    End With
    End Function

    Private Function OutlineRows( _
    ByRef sh As Worksheet, _
    ByRef Currentrow As Long, _
    ByVal Lastrow As Long, _
    ByVal CIs As Variant, _
    ByVal ThisCI As Long)
    Dim i As Long

    With sh

    For i = Currentrow To Lastrow

    Do Until .Cells(i, "A").Interior.ColorIndex = CIs(ThisCI - 1) Or _
    i + 1 > Lastrow

    i = i + 1
    If .Cells(i, "A").Interior.ColorIndex = CIs(ThisCI + 1) Then

    Call OutlineRows(sh, i, Lastrow, CIs, ThisCI + 1)
    End If
    Loop

    If Currentrow = 3 Then Exit Function

    If i <= Lastrow Then sh.Rows(Currentrow).Resize(i - Currentrow).Rows.Group

    If .Cells(i, "A").Interior.ColorIndex = CIs(ThisCI - 1) Then

    Currentrow = i
    Exit Function
    End If
    Next i
    End With
    End Function
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •