Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Columns("D:D")) Is Nothing Then Exit Sub Dim x, lrow As Integer lrow = Range("D1").End(xlDown).Row Range("A2:A" & lrow).ClearContents x = 1 For Each cell In Range("D1:D" & lrow - 1) If cell.Value <> cell.Offset(1, 0).Value Then cell.Offset(1, -3).Value = x x = x + 1 End If Next cell End Sub
Function SNo(dCell As Range) If dCell.Value <> dCell.Offset(-1, 0).Value Then If dCell.Offset(-1, -3).Value = vbNullString Then SNo = Application.WorksheetFunction.Count(Range("A2:A" & dCell.Row - 1)) + 1 ElseIf Application.WorksheetFunction.IsText(dCell.Offset(-1, -3).Value) = True Then SNo = 1 ElseIf Application.WorksheetFunction.IsNumber(dCell.Offset(-1, -3).Value) = True Then SNo = dCell.Offset(-1, -3).Value + 1 End If Else SNo = vbNullString End If End Function
Sub RunMe() Dim x As Integer x = 1 For Each cell In Range("D1:D" & Range("D1").End(xlDown).Row - 1) If cell.Value <> cell.Offset(1, 0).Value Then cell.Offset(1, -3).Value = x x = x + 1 End If Next cell End Sub
DON'T MISS