Outline By Customer Name

**mrmmickle1** · 12-03-2012, 10:04 PM

I have the following code that I have previously used to outline data based on "" values. I was lucky enough to search a forum and modify the code a little bit to get it to work for my needs. However, I am unsure that I understand the code. I thought I could simply change a few numbers to make it work but, I am having trouble. The code is as follows:

Code:

Sub GroupData1()
Dim i As Integer, LastRow As Integer
LastRow = Cells(Rows.Count, 2).End(xlUp).Row

For i = 2 To LastRow

    If Not Left(Cells(i, 2), 3) = "" Then
        Cells(i, 2).EntireRow.Group
    End If

Next i
End Sub

**mrmmickle1** · 12-04-2012, 02:07 AM

I tried to use this code which I got help with a similar issue on before I posted:

I believe ExcelFox was my hero in this case:

Code:

Sub Consolidator()

    Dim obj As Range
    
    'Since there is a possibility that there are already Outlines made in the used range, we'd want to ensure it is removed
    On Error Resume Next
    Do Until Err.Number <> 0
        Worksheets("Sheet1").UsedRange.Rows.Ungroup 'This is where we remove the outlining
    Loop
    Err.Clear: On Error GoTo 0: On Error GoTo -1 'Clear up and reset the error handling
    For Each obj In Worksheets("Sheet1").UsedRange.Columns(5).Cells.SpecialCells(xlCellTypeBlanks) 'We use the specialcells method and pick only the blank cells, and then we loop through each blank cell
        If Not IsEmpty(obj.Offset(2)) Then 'If the cell 2 rows below the blank cell is not empty, then that means there are at least 2 rows to be grouped, in which case End(xlDown) will take use to the last row for that section
            obj.Parent.Range(obj.Offset(1), obj.Offset(1).End(xlDown)).Rows.Group ' so the section of the range that we want to group starts from the first cell below the blank cell, all the way down to the last cell in that group before the next blank, which can be located using End(xlDown) because there are at least 2 rows
        Else
            obj.Offset(1).Rows.Group 'If the cell 2 rows below the blank cell is empty, we can assume that the section to be grouped has only 1 row, so we just group that row
        End If

    Next obj
    
End Sub

**mrmmickle1** · 12-04-2012, 08:04 PM

**mrmmickle1** · 12-04-2012, 10:41 PM

As it turns out there was some kind of strange formatting on the file. It did not register the cells that I was visually seeing as blank to be blank (I hope this makes sense). I ended up copying the data to another sheet and restoring a format that would read blank cells.... This is the resulting code that works:

Code:

Sub Part1of4()
  Columns("A:E").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Sub Part2of4()
Dim i As Integer, LastRow As Integer

'Group Cells in between blanks in column 5

LastRow = Cells(Rows.Count, 5).End(xlUp).row

For i = 2 To LastRow

    If Not Left(Cells(i, 5), 3) = "" Then
        Cells(i, 5).EntireRow.Group
    End If

Next i
End Sub
Sub Part3of4()
'
' AlignUserGroupButtons Macro

    With ActiveSheet.Outline
        .AutomaticStyles = False
        .SummaryRow = xlAbove
        .SummaryColumn = xlLeft
    End With
End Sub
Sub Part4of4()
'Collapses all Groups
    ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
End Sub

Sub RunSalesByCustomer()
Call Part1of4
Call Part2of4
Call Part3of4
Call Part4of4
End Sub

Thread: Outline By Customer Name

Thread Tools

Search Thread

Display

Outline By Customer Name

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions