Automating group creation

Question

I'm trying to write a script to automate creating groups from data being exported from SAP. So the data comes out as follows in the first column with part numbers and descriptions in the following ones.

.1
..2
..2
...3
....4
.1
.1
..2

and so on and so forth with 1 being the highest level and 4 the lowest raw material level there can be one of each or hundreds of each sub-level. Just one export has 2,000-5,000 components so it's a very tedious process starting out with grouping everything manually. So I've been trying to automate this but keep running into walls. My code is a mess and doesn't really do anything but I'll post what I've done.

    Dim myRange As Range
    Dim rowCount As Integer, currentRow As Integer
    Dim GrpRange As Range, GrpStart As Integer, GrpEnd As Integer, GrpCount As Integer
    Dim GrpLoop As Integer, GrpLoopEnd As Integer, GrpLoopEndRow As Integer 
    Dim GrpSt As Integer

GrpSt = 2
GrpStart = 2
GrpEnd = RowEnd(2, 1)
GrpLoopEnd = 100

'Loop through each group
  'For TotalLoop = 2 To GrpEnd

'Determine 1 to 1 row length
For GrpStart = GrpSt To GrpEnd
    Cells(GrpStart, 1).Select
    If Right(ActiveCell, 1) = 1 Then
        GrpSt = ActiveCell.Row
        For GrpLoop = 0 To GrpLoopEnd
            If Right(Cells(GrpSt, 1), 1) = 1 Then
                GrpLoopEnd = 1
                GrpLoopEndRow = ActiveCell.Row
                Exit For
            End If
        Next
    End If

Next GrpStart

I'm first just trying to find the length between each top level 1 and the next one, because sometimes there is structure and sometimes not. Next I was going to do the same for the 2 then 3 then 4 within that one "group", then do the grouping and finally loop through the rest of the column and do the same with each "1 to 1" group. I'm not sure if this is the right way or even possible but I had to start from somewhere.

Here's an example of what is exported:

Here's an example of the grouping I'm looking for:

Answer 1

Try this code:

Sub AutoOutline_Characters()
Dim intIndent As Long, lRowLoop2 As Long, lRowStart As Long
Dim lLastRow As Long, lRowLoop As Long
Const sCharacter As String = "."

application.ScreenUpdating = False

Cells(1, 1).CurrentRegion.ClearOutline

lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

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

For lRowLoop = 2 To lLastRow

    intIndent = IndentCalc(Cells(lRowLoop, 1).Text, sCharacter)

    If IndentCalc(Cells(lRowLoop + 1, "A"), sCharacter) <= intIndent Then GoTo nxtCl:

    For lRowLoop2 = lRowLoop + 1 To lLastRow 'for all rows below our current cell

        If IndentCalc(Cells(lRowLoop2 + 1, "A"), sCharacter) <= intIndent And lRowLoop2 > lRowLoop + 1 Then 'if a higher dimension is encountered
            If lRowLoop2 > lRowLoop + 1 Then Rows(lRowLoop + 1 & ":" & lRowLoop2).Group
            GoTo nxtCl
        End If

    Next lRowLoop2

nxtCl:

Next lRowLoop

application.ScreenUpdating = True

End Sub

Function IndentCalc(sString As String, Optional sCharacter As String = " ") As Long
Dim lCharLoop As Long

For lCharLoop = 1 To Len(sString)
    If Mid(sString, lCharLoop, 1) <> sCharacter Then
        IndentCalc = lCharLoop - 1
        Exit Function
    End If
Next

End Function