Increment alphanumeric sequence to next row by 1

[PierreT]

Good day,

I've found a macro online that increments cells with numerical value by 1 and inserts it in the row below when you double click the cell.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lastrow As Long
lastrow = Cells(Cells.Rows.Count, "k").End(xlUp).Row + 1
If Not Intersect(Target, Range("k:k")) Is Nothing Then
If Target.Address = Cells(lastrow, "k").Address Then
Application.EnableEvents = False
Cancel = True
Cells(lastrow, "k") = Cells(lastrow - 1, "k") + 1
Application.EnableEvents = True
End If
End If
End Sub

Is there a way the code can be altered to include alphanumerical value?
The data in my cells are as follow: LI0000, LI0001, LI0002 etc. The current formula will not support it.

Any help would be much appreciated.

Thank you.

 

[Scott T]

If it is always two alpha then 4 numbers this should work

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lastrow As Long
lastrow = Cells(Cells.Rows.Count, "k").End(xlUp).Row + 1
If Not Intersect(Target, Range("k:k")) Is Nothing Then
    If Target.Address = Cells(lastrow, "k").Address Then
        Application.EnableEvents = False
        Cancel = True
        firsttwo = Left(Cells(lastrow - 1, "K"), 2)
        nums = Right(Cells(lastrow - 1, "K"), 4)
        Cells(lastrow, "k") = firsttwo & Format(nums + 1, "0000")
        Application.EnableEvents = True
    End If
End If
End Sub

 

[PierreT]

Works like a charm. Thank you.

If it is not too much to ask, as the numbers gets inserted in the next row, how could I get a border around the cell K (which is the cell with the number in) and cell , L and M)?

Thanks again.

 

[Scott T]

Not sure of you want it around the range K to M or each cell in K to M so the code for both is included just uncomment the line you want. The other line can be deleted.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lastrow As Long
lastrow = Cells(Cells.Rows.Count, "k").End(xlUp).Row + 1
If Not Intersect(Target, Range("k:k")) Is Nothing Then
    If Target.Address = Cells(lastrow, "k").Address Then
        Application.EnableEvents = False
        Cancel = True
        firsttwo = Left(Cells(lastrow - 1, "K"), 2)
        nums = Right(Cells(lastrow - 1, "K"), 4)
        Cells(lastrow, "k") = firsttwo & Format(nums + 1, "0000")
[INDENT]'Uncomment the line below (remove the ' at the start of the line) to make border around each cell[/INDENT]
        'Range("K" & lastrow & ":M" & lastrow).Borders.LineStyle = xlContinuous
[INDENT]'Uncomment the line below (remove the ' at the start of the line) to make border around the range[/INDENT]
        'Range("K" & lastrow & ":M" & lastrow).BorderAround (xlContinuous)
        Application.EnableEvents = True
    End If
End If
End Sub

 

[PierreT]

Thanks for your help Scott T. and thanks for the quick turn around.

 

[Scott T]

Glad to help