Add Serial Number using VBA

[SamarthSalunkhe]

Hi All,

I am using below code to update current Date in column B, code is working fine but I want to add serial number after Date.

Can anyone help me with the correction in below code.

Sub Update_Data()

Dim lr As Long

    lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    If Not IsEmpty(Sheet2.Range("A2:A" & lr).Value) Then Sheet2.Range("B2:B" & lr).Value = Format(Date, "DDMMYYYY")

End Sub

Thank you very much.

 

[Legacy 143009]

Can be something like this:

If Not IsEmpty(Sheet2.Range("A2:A" & lr).Value) Then Sheet2.Range("B2:B" & lr).Value = Format(Date, "DDMMYYYY")&Format(Right(Sheet2.Range("B2:B" & lr).Value,6)+1, "000000")

But it has to start with something like 16032023000001 already in place.

 

[SamarthSalunkhe]

Can be something like this:

If Not IsEmpty(Sheet2.Range("A2:A" & lr).Value) Then Sheet2.Range("B2:B" & lr).Value = Format(Date, "DDMMYYYY")&Format(Right(Sheet2.Range("B2:B" & lr).Value,6)+1, "000000")

But it has to start with something like 16032023000001 already in place.

Tried but getting below error.

 

[Legacy 143009]

Sorry, I don't know what is the problem. I works fine for me.

Before:

After:

 

[SamarthSalunkhe]

Sorry, I don't know what is the problem. I works fine for me.

Before:
View attachment 87640
After:
View attachment 87641

@Flashbond

Thank you for your time,

Actually I am new in VBA, let see if anyone can resolve the error.

 

[Legacy 143009]

Please try this if no sequential identifier is required:

Sub Update_Data()

Dim lr As Long

    lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    If Not IsEmpty(Sheet2.Range("A2:A" & lr).Value) Then Sheet2.Range("B2:B" & lr).Value = Format(Date, "DDMMYYYY") & CStr(Timer * 100)

End Sub

 

[SamarthSalunkhe]

Please try this if no sequential identifier is required:

Sub Update_Data()

Dim lr As Long

    lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    If Not IsEmpty(Sheet2.Range("A2:A" & lr).Value) Then Sheet2.Range("B2:B" & lr).Value = Format(Date, "DDMMYYYY") & CStr(Timer * 100)

End Sub

@Flashbond

Code is working fine but not getting unique number in each row.

 

[Legacy 143009]

Sub Update_Data()

Dim lr As Long

    lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    If Not IsEmpty(Sheet2.Range("A2:A" & lr).Value) Then Sheet2.Range("B2").Value = Format(Date, "DDMMYYYY") & CStr(Timer * 100)
    Sheet2.Range("B2").AutoFill Destination:=Sheet2.Range("B2").Resize(lr-1), Type:=xlFillSeries
End Sub

 

[SamarthSalunkhe]

Sub Update_Data()

Dim lr As Long

    lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    If Not IsEmpty(Sheet2.Range("A2:A" & lr).Value) Then Sheet2.Range("B2").Value = Format(Date, "DDMMYYYY") & CStr(Timer * 100)
    Sheet2.Range("B2").AutoFill Destination:=Sheet2.Range("B2").Resize(lr-1), Type:=xlFillSeries
End Sub

Don't know why but again getting same reference number in each row.

 

[Legacy 143009]

Sorry, I works perfectly fine for me. Maybe you should wait for another answer.

Beside the problem, this check has no useful meaning. Just for your information:

Not IsEmpty(Sayfa2.Range("A2:A" & lr).Value)