Help with vba macro for auto generating unique ID number

[studentpro]

I am a pharmacy student in serious need of help for my internship.
I need a macro/vba code that auto generates when there is cell content in a row of a worksheet. this number is going to be an invoice number. I current have a 'masterfile' that records all finalized orders for each facility. Every row represents 1 order.
I need a code to generate a number that looks like this: CD-1000
the "CD-" is fixed and won't change, but the "1000" needs to be unique for every row line
in the masterfile, columns A thru J are auto-populated with the finalized order and I want column K to be where the invoice number lives.
I want the code to work something like this:
find empty cell in column k_generate invoice # for columns cells K based on last previous cell invoice # for all column k cells that have content in row to the left and stop generating when rows are empty. the invoice number that generated should never be used again even if its not in the masterfile any more and a row's invoice number should never be changed/recalculated when the code runs again.

I have already tried the vba that references the first cell in column K then adds +1 down, but that does not work because it either produced a duplicate number already used, or every time the macro ran, it would recalculate every cell in column k which would change an order invoice because an order can be deleted from the masterfile but that order still exist in other reports.

Any ideas on how to set this up? I would appreciate any help or suggestions!

 

[mrmmickle1]

If your data looks like this:

Excel 2010
	J	K
1	Text	CD-0001
2	Text	CD-0002
3	Text	CD-0003
4	Text	CD-0004
5	Text	CD-0005
6
7
8	Text
9	Text
10	Text	CD-0006
11	Text	CD-0007
12	Text	CD-0008
13	Text	CD-0009
14	Text	CD-0010
15	Text	CD-0011
16	Text
17
18
19	Text
Sheet1

Do you expect to get this?

Excel 2010
	J	K
1	Text	CD-0001
2	Text	CD-0002
3	Text	CD-0003
4	Text	CD-0004
5	Text	CD-0005
6
7
8	Text	CD-0012
9	Text	CD-0013
10	Text	CD-0006
11	Text	CD-0007
12	Text	CD-0008
13	Text	CD-0009
14	Text	CD-0010
15	Text	CD-0011
16	Text	CD-0014
17
18
19	Text	CD-0015
Sheet1

 

[studentpro]

This is correct! MrMMickle1

 

[mrmmickle1]

studentpro,

Assume we have data like this:

Excel 2010
	J	K
1	Header	Header
2	Text	1
3	Text	2
4	Text	3
5	Text	4
6	Text	5
7
8
9	TEXT	12
10	TEXT	13
11	Text	6
12	Text	7
13	Text	8
14	Text	9
15	Text	10
16	Text	11
17	TEXT	14
18
19
20	TEXT	15
Sheet1

Let's assign a custom format to your number values

1. Highlight Column K
2. Right Click
3. Select Format Cells
4. Select Custom
5. Enter this Custom Format ---> "CD-"0000

You should now see this:

Excel 2010
	J	K
1	Header
2	Text	CD-0001
3	Text	CD-0002
4	Text	CD-0003
5	Text	CD-0004
6	Text	CD-0005
7
8
9	TEXT	CD-0012
10	TEXT	CD-0013
11	Text	CD-0006
12	Text	CD-0007
13	Text	CD-0008
14	Text	CD-0009
15	Text	CD-0010
16	Text	CD-0011
17	TEXT	CD-0014
18
19
20	TEXT	CD-0015
Sheet1

Now you can use this code to update your values.

[COLOR=#0000ff]Sub[/COLOR] Test()


   [COLOR=#0000ff] Dim[/COLOR] myMaxVal [COLOR=#0000ff]As Long[/COLOR]
 [COLOR=#0000ff]   Dim[/COLOR] ColKLRow [COLOR=#0000ff]As Long[/COLOR]
[COLOR=#0000ff]    Dim [/COLOR]mySht [COLOR=#0000ff]As [/COLOR]Worksheet
    
 [COLOR=#0000ff]   Set[/COLOR] mySht = Sheets("Sheet1")[COLOR=#008000] 'Change Accordingly[/COLOR]
    myMaxVal = Application.WorksheetFunction.Max(Range("K2:K10000"))[COLOR=#008000] 'Get Max Value in K <---Adjust Range Accordingly[/COLOR]
    ColKLRow = mySht.Cells(Rows.Count, "J").End(xlUp).Row [COLOR=#008000]'Get Last Row Column J[/COLOR]
    
[COLOR=#008000]    'Cycle through values in J and K and look for empties...[/COLOR]
    For LngLp = 2 To ColKLRow
    
   [COLOR=#0000ff]     With[/COLOR] mySht
       [COLOR=#0000ff]     If [/COLOR].Cells(LngLp, "J") <> "" [COLOR=#0000ff]And[/COLOR] .Cells(LngLp, "K") = "" [COLOR=#0000ff]Then[/COLOR]
                 myMaxVal = myMaxVal + 1[COLOR=#008000] 'Increment Number By 1[/COLOR]
                .Cells(LngLp, "K") = myMaxVal [COLOR=#008000]'Put Value in Cell[/COLOR]
[COLOR=#0000ff]            End If[/COLOR]
[COLOR=#0000ff]        End With[/COLOR]
[COLOR=#0000ff]    [/COLOR]
[COLOR=#0000ff]    Next[/COLOR] LngLp
[COLOR=#0000ff]
[/COLOR]
[COLOR=#0000ff]End Sub[/COLOR]

 

[studentpro]

Mr. Mickle, thank you very much. The VBA works perfectly. I couldn't thank you enough.

 

[mrmmickle1]

You're quite welcome. Glad you were able to get it working.

 

[Rick Rothstein]

Here is another (slightly more compact) macro that should also work...

[table="width: 500"]
[tr]
	[td]Sub Test()
  Dim LastRow As Long, Max As Variant, Cell As Range
  LastRow = Cells(Rows.Count, "J").End(xlUp).Row
  Max = Evaluate("MAX(IF(K1:K" & LastRow & "="""",0,0+MID(K1:K" & LastRow & ",4,4)))")
  For Each Cell In Intersect(Columns("J").SpecialCells(xlConstants).Offset(, 1), Columns("K").SpecialCells(xlBlanks))
    Max = Max + 1
    Cell.Value = Format(Max, """CD-""0000")
  Next
End Sub[/td]
[/tr]
[/table]

 

[Rick Rothstein]

Here is another (slightly more compact) macro that should also work...

[table="width: 500"]
[tr]
	[td]Sub Test()
  Dim LastRow As Long, Max As Variant, Cell As Range
  LastRow = Cells(Rows.Count, "J").End(xlUp).Row
  Max = Evaluate("MAX(IF(K1:K" & LastRow & "="""",0,0+MID(K1:K" & LastRow & ",4,4)))")
  For Each Cell In Intersect(Columns("J").SpecialCells(xlConstants).Offset(, 1), Columns("K").SpecialCells(xlBlanks))
    Max = Max + 1
    Cell.Value = Format(Max, """CD-""0000")
  Next
End Sub[/td]
[/tr]
[/table]

I just noticed that Matt made a different assumption than I did as to what is in your cells. The code above assumes Column K values are text that actually contain the characters "CD-" along with the number... Matt assumed the cells contained real numbers that were Cell Formatted to provide those characters. If Matt's assumption about what is in your cells is correct, then the above code will not work; however, the following (still somewhat compact) code will...

[table="width: 500"]
[tr]
	[td]Sub Test()
  Dim LastRow As Long, Max As Variant, Cell As Range
  Max = Application.Max(Range("K:K"))
  For Each Cell In Intersect(Columns("J").SpecialCells(xlConstants).Offset(, 1), Columns("K").SpecialCells(xlBlanks))
    Max = Max + 1
    Cell.Value = Max
    [B][COLOR="#FF0000"]Cell.NumberFormat = """CD-""0000"[/COLOR][/B]
  Next
End Sub[/td]
[/tr]
[/table]

Note: The red highlighted line of code formats the cell with the "CD-" characters... I notice Matt's code does not do that which means he assumed you preformatted the column with the required Custom Format... if you did that, then you can delete the red highlighted line of code as its action would be redundant.

 

[mrmmickle1]

Rick,

Another great use of intersect. Great way to minimize iterations!