PDA

View Full Version : macro to generate next serial NO



arnab0711
06-20-2012, 03:41 AM
Hi ,
I have a command button on column A1,on clicking that I want to generate the next serial number like --
KO/OP/12/R01
KO/OP/12/R02
KO/OP/12/R03
KO/OP/12/R04
KO/OP/12/R05
Now here is a catch,if I have clicked on next serial number and deleted the number and again clicked for next serial,it should give the next serial only.for example if I click on KO/OP/12/R03 and delete it and click for another serial it should give me KO/OP/12/R03 only not KO/OP/12/R04.

GTO
06-20-2012, 04:19 AM
Howdy there,

In looking at 'KO/OP/12/R05' for example. What is, or that is, what should be, the next value after 'KO/OP/12/R99'?

In gist - I think we need some sort of orderly pattern to determine a 'number' value for our serial numbers. I hope that makes sense :-)

Mark

arnab0711
06-20-2012, 04:30 AM
It will continue after r99 it will be r100

snb
06-20-2012, 06:09 AM
Why don't you use:

Sub Macro1()
with cells(rows.count,1).end(xlup)
.AutoFill .Resize(2)
end with
End Sub

IanFScott
06-20-2012, 06:14 AM
Or play around with:

Private Sub CommandButton1_Click()
Dim CRow As Integer
Dim strPNum As String
Dim intPNum As Integer
Dim intPos As Integer
With Me
CRow = 2
Do Until IsEmpty(.Cells(CRow, 1))
CRow = CRow + 1
Loop
strPNum = .Cells(CRow - 1, 1)
intPos = Len(strPNum)
Do Until Not IsNumeric(Mid(strPNum, intPos, 1))
intPos = intPos - 1
Loop
intPNum = CInt(Right(strPNum, Len(strPNum) - intPos))
intPNum = intPNum + 1
strPNum = Left(strPNum, intPos) & Format(intPNum, "00")
.Cells(CRow, 1) = strPNum
End With
End Sub

GTO
06-20-2012, 02:51 PM
Hi ,
I have a command button on column A1,on clicking that I want to generate the next serial number like --
KO/OP/12/R01
KO/OP/12/R02
KO/OP/12/R03
KO/OP/12/R04
KO/OP/12/R05
Now here is a catch,if I have clicked on next serial number and deleted the number and again clicked for next serial,it should give the next serial only.for example if I click on KO/OP/12/R03 and delete it and click for another serial it should give me KO/OP/12/R03 only not KO/OP/12/R04.

Okay, I am not utterly sure (probably just a 'blond moment' for me) if you mean to look for the highest currently existing value, or, look to fill holes (so-to-speak). If just looking for the highest current value, maybe like:

Option Explicit

Private Sub CommandButton1_Click()
Static REX As Object ' RegExp
Static DIC As Object ' Dictionary
Dim arySerNums As Variant
Dim lLastRow As Long
Dim n As Long

If REX Is Nothing Then Set REX = CreateObject("VBScript.RegExp")
If DIC Is Nothing Then Set DIC = CreateObject("Scripting.Dictionary")

lLastRow = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row

If lLastRow > 1 And Not REX Is Nothing And Not DIC Is Nothing Then

If DIC.Count > 0 Then DIC.RemoveAll
arySerNums = Sheet1.Range(Sheet1.Cells(2, 1), Sheet1.Cells(lLastRow, 1)).Value

With REX
.Global = False
.IgnoreCase = True
.Pattern = "(KO/OP/12/R)([0-9]+)"
For n = 1 To UBound(arySerNums, 1)
If .Test(arySerNums(n, 1)) Then
DIC.Item(CLng(.Execute(arySerNums(n, 1))(0).SubMatches(1))) = Empty
End If
Next
End With
Sheet1.Cells(lLastRow + 1, 1).Value = "KO/OP/12/R" & Format(Application.Max(DIC.Keys) + 1, "00")
Else
MsgBox "error w/object or no seed values"
End If
End Sub
If wanting to 'fill holes', maybe?

Private Sub CommandButton2_Click()
Static REX As Object ' RegExp
Static DIC As Object ' Dictionary
Dim arySerNums As Variant
Dim lLastRow As Long
Dim n As Long
Dim lHiVal As Long
Dim lFirstMiss As Long

If REX Is Nothing Then Set REX = CreateObject("VBScript.RegExp")
If DIC Is Nothing Then Set DIC = CreateObject("Scripting.Dictionary")

lLastRow = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row

If lLastRow > 1 And Not REX Is Nothing And Not DIC Is Nothing Then

If DIC.Count > 0 Then DIC.RemoveAll
arySerNums = Sheet1.Range(Sheet1.Cells(2, 1), Sheet1.Cells(lLastRow, 1)).Value

With REX
.Global = False
.IgnoreCase = True
.Pattern = "(KO/OP/12/R)([0-9]+)"
For n = 1 To UBound(arySerNums, 1)
If .Test(arySerNums(n, 1)) Then
DIC.Item(CLng(.Execute(arySerNums(n, 1))(0).SubMatches(1))) = Empty
End If
Next
End With

lHiVal = Application.Max(DIC.Keys)

For n = 1 To lHiVal
If Not DIC.Exists(n) Then
lFirstMiss = n
Exit For
End If
Next

If lFirstMiss > 0 Then
Sheet1.Cells(lLastRow + 1, 1).Value = "KO/OP/12/R" & Format(lFirstMiss, "00")
Else
Sheet1.Cells(lLastRow + 1, 1).Value = "KO/OP/12/R" & Format(Application.Max(DIC.Keys) + 1, "00")
End If
Else
MsgBox "error w/object or no seed values"
End If
End Sub
Minimally tested, but I think that should fill in the lowest missing value, or the next in series.

Hope that helps,

Mark