I start with a sheet like this:

row1: 20
row2: (empty)
row3: (empty)
row4: 60
row5: (empty)
row6: 45
row7: (empty)
row8: (empty)
row9: 88
row10: (empty)
row11: 10
...
rowN: 67

I want to divide the value of non-empty cells ex 15 in row 1 into the number of following cells that are blank and then delete the original row so it would look like this after the transformation column O will look like this:

colB:
row2: 10
row3: 10
row5: 60
row7: 22.5
row8: 22.5
row10: 88
...
rowN: 67

There is a very similar question: Divide the value of non-blank cells (in a column) amongst empty cells and repeat with vba

but i can`t get rid of rows or the division by the blanks 1 in his case as i just want the division to be done by number of blank cells below.

Would appreciate any help with this.

I kinda got it to work like this:

Dim max As Long, i As Long, b As Long, cell As Range

Set cell = Range("K2")
max = Range("K" & Rows.Count).End(xlUp).Row

Do
    i = i   1
    If (cell.Offset(i, 0).Value <> "") Then
        b = i - 1
        Range(cell, cell.Offset(i - 1, 0)).Value = cell.Value / b
        Set cell = cell.Offset(i, 0)
        i = 0
    End If

    If cell.Row = max Then Exit Sub
Loop

CodePudding user response：

Divided By Blanks

Option Explicit

Sub DividedByBlanks()
   
    Const scAddress As String = "A1"
    Const dcAddress As String = "B1"
    Const RoundDecimals as long = 2
    
    Dim ws As Worksheet: Set ws = ActiveSheet

    Dim srg As Range
    Dim rCount As Long
    ' Reference the source one-column range.
    With ws.Range(scAddress)
        Dim lcell As Range: Set lcell = .Resize(.Worksheet.Rows.Count _
            - .Row   1).Find("*", , xlFormulas, , , xlPrevious)
        If lcell Is Nothing Then Exit Sub ' no data
        rCount = lcell.Row - .Row   1
        Set srg = .Resize(rCount)
    End With
    
    Dim Data As Variant
    ' Write from the source range to a 2D one-based one-column array.
    If rCount = 1 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = srg.Value
    Else
        Data = srg.Value
    End If
    
    Dim cValue As Variant
    Dim cNum As Double
    Dim r As Long
    Dim sRow As Long
    Dim eRow As Long
    Dim rr As Long
    Dim HasStarted As Boolean
    ' Write the results to the same array.        
    For r = 1 To rCount
        cValue = Data(r, 1)
        If Len(CStr(cValue)) > 0 And IsNumeric(cValue) Then
            HasStarted = True
            If eRow > sRow Then
                cNum = Round(cNum / (eRow - sRow), RoundDecimals)
                For rr = sRow To eRow - 1
                    Data(rr, 1) = cNum
                Next rr
            End If
            cNum = CDbl(cValue)
            sRow = r   1
            eRow = sRow
            Data(r, 1) = Empty
        Else
            If HasStarted Then
                eRow = eRow   1
            End If
        End If
    Next r
    
    With ws.Range(dcAddress)
        ' Write the values from the array to the destination range.
        .Resize(rCount).Value = Data
        ' Clear below.
        .Resize(.Worksheet.Rows.Count - .Row - rCount   1).Offset(rCount).Clear
    End With

End Sub