$10 - Count rows between cells and add rows if needed

I have some data in column a which acts as heading, the same text is used for each heading. There could be up to 300 of these headings.

I would like to be able to count the number of rows from the first instance of this to the next. If its less than 50 rows, add rows until the range has 50 rows.

So for example, the first instance of this text is in cell A1, the second is in A51, third A72. The number of rows between the first 2 instances is 50 rows so nothing need be done. The number of rows between the second and third instance is only 21 rows so I need to add in 39 rows.

Can anyone help? Thanks.

Re: Count rows between cells and add rows if needed

Having looked through some other posts on this forum, I found this code that identifies the number of instances of the criteria (in this case the text string start). It also works how how many rows is between each instance of the criteria occuring. It then puts that data into cell B1 of the active sheet.

This code was created by rbrhodes

Sub spaced()     
    Dim rowz()
    Dim i As Long
    Dim c As Range
    Dim found As Long
    Dim rownum As Long
    Dim lastrow As Long
    Dim fined As String
    Dim retstring As String
    Dim firstaddress As String
     
     'get lastrow col A
    lastrow = Range("A65536").End(xlUp).Row
     'set array
    ReDim rowz(lastrow)
     'input number to find
    fined = "start"
     'find it
    With Worksheets(1).Range("A1:A" & lastrow)
        Set c = .Find(fined, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstaddress = c.Address
             'store it
            i = 1
            rowz(i) = c.Row - 1
            rownum = c.Row + 1
             'number of times found
            found = 1
            Do
                 'increment array
                i = i + 1
                 'find again...
                Set c = .FindNext(c)
                 'store
                rowz(i) = (c.Row) - rownum
                rownum = c.Row + 1
                 'incr
                found = found + 1
            Loop While Not c Is Nothing And c.Address <> firstaddress
        End If
    End With
     'build string
    retstring = fined & " has " & found - 1 & " occurences. ("
     'populate
    For i = 1 To UBound(rowz)
        If rowz(i) > 0 Then
            retstring = retstring & rowz(i) & ", "
        ElseIf Right(retstring, 1) = "(" Then
             'not found at all
            Cells(1, 2) = Left(retstring, Len(retstring) - 1)
            Exit Sub
        Else
             'end population
            retstring = Left(retstring, Len(retstring) - 2) & ")"
            Exit For
        End If
    Next i
     
     '**CHANGE TO SUIT***
     'return value to ROW 1, COL 2 (B1)
    Cells(1, 2) = retstring




End Sub

I have tried adapting it to add rows but its way beyond me.

$10 - Count rows between cells and add rows if needed

anyone?? would be willing to pay $10 usd if someone wants to move this to the hire help section

Re: $10 - Count rows between cells and add rows if needed

Hi, I have added a sample workbook and added a text box to describe what I would like the macro to do.

The sample workbook only shows data in column A, and only a very small sample, which is the only data necessary to achieve my requirements. I state in the workbook that I need it to always be 50 rows between each instance. If possible could this be made into a variable so that I can change the number of rows required between each instance.

I am unable to use the exact workbook I intend the macro for since it has confidential material on it. I will be transferring the code from this sample workbook to the other workbook.

Re: $10 - Count rows between cells and add rows if needed

Thanks for that, it works nicely with my sample workbook. I will add the code to my other workbook on Monday, hopefully all will go well.