Automatically create a group

**ricardov** · 05-11-2012, 06:12 AM

I am looking for a piece of code that will automatically create a group. The code should check column A and if there is no content in column A it should create a group under the last cell with a value in A. I attach an example. Referring to the spreadsheet, I would expect to see a group being formed from row 5 to row 23. Is it possible to automate?

**arlu1201** · 05-11-2012, 06:14 AM

What do you mean by group? Are you talking about the "Group" option available under Data-> Group? Can you upload a sample output file so we understand what you need?

**ricardov** · 05-11-2012, 06:26 AM

Pretty much exactly what you say arlu. At the moment I am doing it by hand - highlighting several rows then hitting group in the data tab. I have a massive amount of sheets to do thie exercise on, there must be an easier way haha. I have attached the same file amended to what I expect to see.

**arlu1201** · 05-14-2012, 06:39 AM

Try this code on 1 worksheet

Option Explicit

Sub create_groups()
Dim lrow As Long, i As Long, startrange As Long, endrange As Long

Application.ScreenUpdating = False

With Worksheets("Sheet1")
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = 2 To lrow
        If .Range("A" & i).Value = "" And .Range("A" & i - 1).Value <> "" Then
            startrange = i
        ElseIf .Range("A" & i).Value = "" And .Range("A" & i + 1).Value = "" Then
            endrange = i + 1
        ElseIf .Range("A" & i).Value = "" And .Range("A" & i + 1).Value <> "" Then
            endrange = i
            .Rows(startrange & ":" & endrange).Group
        End If
    Next i
End With

Application.ScreenUpdating = True

End Sub

If its working fine, i can help you in making it work for other worksheets too. Also, please put some text in the row after the last row of data so that the macro will group that set of data as well. Once you test it, you will realise that the last set of rows are not being grouped. Once you put some text such as "End" it should work.