Need Help constructing a vba counts rows between data and. Please

[estatefinds]

Hello, I have data in Columns A to O from row 2 to 38.


Row 1 shows the values as the header for the data below;
For example column A, row 10, shows the number 1 highlighted in red. The next red highlighted 1 is in row 18 and the next highlighted 1 is in row 26.

I need a macro that would count the empty rows between the A10 and the A18 and place this count of 7 in the column Al 17 because there are 7 empty rows between the two red highlighted values of 1.

The macro would continue downwards counting the empty rows between A 18 and A26 which coincidentally is 7 and place this data in column AL 25.

The macro would continue to go to next value of 2 and do similar actions. So for example, the count would start in Column B24 and count the empty row between the B24 and B26 which is one row so the 1 would be placed in column AM 25 then the macro continues down to B26 and counts the empty rows between B26 and B34 which is a count of 7 empty rows and this count of 7 would then go to column AM 33 and so on.

I am attaching a file to show what it should look like.

Thank you in advance for your help!

[estatefinds]

i FOR GOT TO ADD CODE cAN ANY ONE HELP ME SET THIS UP SO WORKS TO MY DESCRIPTION AND FILE? pLEASE


Sub countblank()
'This will count the number of rows that have a blank cell in column "A"
Const column_to_test = 1 'first column (A)
Dim r As Range
Set r = Range(Cells(1, column_to_test), Cells(Rows.Count, column_to_test).End(xlUp))
MsgBox ("There are " & r.SpecialCells(xlCellTypeBlanks).Count & " Rows with blank cells")


'You may want to select those rows (for deletion?)



r.SpecialCells(xlCellTypeBlanks).EntireRow.Select 'change .Select to .Delete


End Sub

I dont need message box.

[mikerickson]

I think this will do what you want

Sub test()
    Dim sourceColumn As Range
    Dim outputOffset As Long
    Dim i As Long
    
    outputOffset = Range("AL1").Column - Range("A1").Column
    
    For Each sourceColumn In Sheet1.Range("A1:Ai1").Columns
        With sourceColumn.EntireColumn.SpecialCells(xlCellTypeBlanks)
            .Offset(0, outputOffset).EntireColumn.ClearContents
            For i = 2 To .Areas.Count - 1
                With .Areas(i)
                    .Cells(.Rows.Count, 1).Offset(0, outputOffset).Value = .Rows.Count
                End With
             Next i
        End With
    Next sourceColumn
End Sub

[estatefinds]

WOW!!! It worked Great! Thank you very much! Really appreciate it!