VBA Insert blank row to split a group of cells into equal portions

[hugo2502]

Hi forum gurus,

I'm a novice at VBA, having started to learn it on Friday! I have 50 spreadsheets formatted the same as I'm working on now, and I've been writing code to automate the process. There's one step I can't seem to find answers for on the net.

Essentially I needed to group data when the depth jumps (which I've managed no probs, see column B). I also need to subdivide any groups more than 40 cells in a row into equal portions - I can't figure this bit out.

In the columns below, I have two examples, highlighted in column M. Group 1 has 7 cells in it, group 2 has 50 cells in it. Each group is separated by a blank row. The number of groups varies per spreadsheet, as does the length of each group. If the group is <40 continuous cells (e.g. Group 1), then it's to remain as is. If it's more than 40 cells (e.g. Group 2), split these in half by inserting a blank row after the midpoint. So, for group 2 which runs from M10-M59, insert a new row at M34 (or M35, not fussed).

To complicate things, if there are more than 80 cells, it would have to be subdivided into 3 equal sections; more than 120 cells into 4 sections etc. I've written a quick Mround formula which defines the number of segments each group would have to be divided into in column O. So Group 1 would need to be subdivided 0 times, Group 2 subdivided 1 time.

Any ideas? I'm really bogged down on this.

Thanks in advance, Hugo

	B	L	M	O
1	DEPTH (M)	depth diff	Countgroup	Mround
2	331.0128	0.1524	7	0
3	331.1652	0.1524	7	0
4	331.3176	0.1524	7	0
5	331.47	0.1524	7	0
6	331.6224	0.1524	7	0
7	331.7748	0.3048	7	0
8	332.0796	12.0396	7	0
9
10	485.2416	0.1524	50	1
11	485.394	0.1524	50	1
12	485.5464	0.1524	50	1
13	485.6988	0.1524	50	1
14	485.8512	0.1524	50	1
15	486.0036	0.1524	50	1
16	486.156	0.1524	50	1
17	486.3084	0.1524	50	1
18	486.4608	0.1524	50	1
19	486.6132	0.1524	50	1
20	486.7656	0.1524	50	1
21	486.918	0.1524	50	1
22	487.0704	2.7432	50	1
23	489.8136	0.1524	50	1
24	489.966	0.1524	50	1
25	490.1184	0.1524	50	1

<tbody>
</tbody>

 

[Dendro]

Hi,
Is there other data on this sheet, not belonging to this table? I ask this if it is ok to insert a row in between the ranges? or do you want the macro to move the grouprange down each time?

 

[hugo2502]

Hi Dendro,
There's lots of other data in this sheet (about 21,000 rows and the remainder of the columns hidden at the moment). I've only shown two "groups", but there are hundreds.
Please insert a blank row in between the ranges. There currently is a blank row already between each of the group, but a blank row to subdivide each range would be fantastic!

Hugo

 

[Dendro]

great, let me try some code, brb

 

[Dendro]

Hi, i'm trying to write a code, but i'm having an error "overloop". I'm trying to fix it but maybe you or someone else can help me see where the error is.

Sub dividegroups()

Dim LastRow As Integer
Dim groupsizefirst As Double
Dim groupsizeother As Double
Dim currentrow As Integer

LastRow = Range("A" & Rows.Count).End(xlUp)

For i = 2 To LastRow
    If Cells(i - 1, 13) = "" And Cells(i - 1, 15).Value <> 0 Then
    groupsizefirst = Application.WorksheetFunction.RoundUp(Cells(i - 1, 13).Value / (Cells(i - 1, 15).Value+1), 0)
    groupsizeother = Application.WorksheetFunction.RoundDown(Cells(i - 1, 13).Value / (Cells(i - 1, 15).Value+1), 0)

    Rows(groupsizefirst + 2).EntireRow.Insert 'start counting at row 2(headers) and we want to insert the row below the first group, thus +2
    currentrow = Rows(groupsizefirst) + 3
    j = groupsizefirst
        Do While j < Cells(i - 1, 13).Value
        Rows(currentrow + groupsizeother + 1).EntireRow.Insert
        j = j + groupsizeother
        Loop
    End If
Next i

End Sub

 

[Dendro]

nvm the above code, the logic is wrong, i'm changing the code now

 

[Dendro]

So here is the code with in my opinion the correct logic, but the overloop problem is not solved yet. However I'm not going to try to solve that problem before the op replies. sorry for the multi-posting

Sub dividegroups()

Dim LastRow As Integer
Dim groupsizefirst As Double
Dim groupsizeother As Double
Dim currentrow As Integer

LastRow = Range("A" & Rows.Count).End(xlUp)
lastblank = 2
For i = 2 To LastRow
    If Cells(i - 1, 13) = "" And Cells(i - 1, 15).Value = 0 Then
    lastblank = i
    End If
    If Cells(i - 1, 13) = "" And Cells(i - 1, 15).Value <> 0 Then
        With Sheets("Blad1")
        groupsizefirst = Application.RoundUp((.Cells(i - 1, 13).Value / (.Cells(i - 1, 15).Value + 1)), 0)
        groupsizeother = Application.RoundDown((.Cells(i - 1, 13).Value / (.Cells(i - 1, 15).Value + 1)), 0)
        End With
    
    Rows(lastblank + groupsizefirst + 1).EntireRow.Insert 'start counting at row 2(headers) and we want to insert the row below the first group, thus +2
    currentrow = lastblank + groupsizefirst + 2
    i = i + 1
    j = groupsizefirst
        Do While j < (Cells(i - 1, 13).Value - groupsizeother)
        Rows(currentrow + groupsizeother + 1).EntireRow.Insert
        i = i + 1
        j = j + groupsizeother
        Loop
        lastblank = i
    End If
Next i

End Sub

 

[hugo2502]

Hi Dendro,

Thanks for your help - unfortunately nothing happening yet?

Also, what's the code for making a dynamic sheet range. At the moment your code is:

With Sheets("Blad1")

Hugo
</pre>

 

[Dendro]

found this

<code>Dim ws As Worksheet</code><code>For each ws in thisworkbook.sheets     
'do something on each worksheet 
next

</code>