![]()
Sub blanks_and_stuff() Dim r&, c&, i&, j&, k&, a, u() r = Cells.Find("*", , , , xlByRows, xlPrevious).Row c = Cells.Find("*", , , , xlByColumns, xlPrevious).Column For j = 1 To c Step 2 a = Cells(2, j).Resize(r) ReDim u(1 To r, 1 To 1) For i = 1 To r - 1 If Len(a(i, 1)) = 0 Then k = k + 1 Else If k > 0 Then u(i, 1) = k: k = 0 End If Next i Cells(2, j + 1).Resize(r) = u If Len(a(1, 1)) = 0 Then Cells(j + 1).End(4) = "#NA" k = 0 Next j End Sub
Bookmarks