How to auto number rows if adjacent cell is not blank using VBA Excel?-CodePudding

I need to auto number rows if adjacent cell is not blank using VBA.
any one from below codes works perfectly , except if it counter blank cells.
as always, your support is much appreciated.
this the expected output

Sub Fill_Serial_Numbers_Option1()
  Dim LastRow As Long
  LastRow = Cells(Rows.count, "B").End(xlUp).Row
  If LastRow > 2 Then
     Range("A3:A" & Application.Max(2, LastRow)) = Evaluate("ROW(A1:A" & LastRow & ")")
  End If
End Sub

Sub Fill_Serial_Numbers_Option2()
  Dim LastRow As Long
  LastRow = Cells(Rows.count, "B").End(xlUp).Row
  If LastRow > 2 Then
  With Range("A3:A" & LastRow)
    .Cells(1, 1).value = 1
    .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Trend:=False
  End With
  End If
End Sub

CodePudding user response：

Please, test the next code:

Sub testCountNonBlanks()
   Dim sh As Worksheet, lastR As Long, arr, arrA, count As Long, i As Long
   Set sh = ActiveSheet
   lastR = sh.Range("B" & sh.rows.count).End(xlUp).row: count = 1
   If lastR <= 2 Then Exit Sub
   arr = sh.Range("B2:B" & lastR).value 'place the range in an array for faster iteration
   arrA = sh.Range("A2:A" & lastR).value
   For i = 1 To UBound(arr)
        If arr(i, 1) <> "" Then arrA(i, 1) = count: count = count   1
   Next i
   sh.Range("A2").Resize(UBound(arrA), 1).value = arrA
End Sub

If a formula (written in VBA) is allowed, you can use the next variant:

Sub testCountByFormula()
  Dim sh As Worksheet, lastR As Long, rngB As Range
  
   Set sh = ActiveSheet
   lastR = sh.Range("B" & sh.rows.count).End(xlUp).row
   Set rngB = sh.Range("B2:B" & lastR)
   sh.Range("A2:A10").Formula = "=IF(B2<>"""",COUNTA(" & rngB.Address & ")-COUNTA(" & rngB.Address(0, 1) & ") 1,"""")"
End Sub

CodePudding user response：

You don't need a macro to accomplish this. Assuming all you care about is blank or not, then you can use a formula like this in cell A9. =Counta($B$1:$B9) If you have formulas you can try to leverage something with COuntif.

CodePudding user response：

You can use a loop from the first row to the last one, something like this:

Sub Fill()
    Dim LastRow As Long
    Dim Count As Integer
    Dim Row As Integer
    
    Count = 0
    Row = 1
    LastRow = Cells(Rows.Count, "B").End(xlUp).Row
    
    
    Do While Row <= LastRow
        If Not (Cells(Row, 2) = "") Then
            Count = Count   1
            Cells(Row, 1) = Count
        End If
        Row = Row   1
        
    Loop

End Sub