Macro to assign consecutive numbers to non-consecutive cells

[meadscarla]

I am trying to assign a unique, consecutive value to cells in column D based on the value in the corresponding cell in column A. Wherever the cell in Column A equals "New", a value should be populated into the cell in column D.
This value should be a user defined code of letters followed by 0001, 0002, 0003 etc.

i.e. I am trying to achieve this:

A	D
New	ABC0001
Old
Changed
Old
New	ABC0002
New	ABC0003
Old
New	ABC0004

<tbody>
</tbody>

The user defined code of letters is input via an input box. Here is what I have so far.

InterimCode = InputBox("Please enter code for Interim Number")
Range("D1").Select
Do
ActiveCell.Offset(1, 0).Range("A1").Select
If ActiveCell.Offset(0, -3).Range("A1") = "New" Then
ActiveCell.FormulaR1C1 = InterimCode & "0001"
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
Loop Until IsEmpty(ActiveCell.Offset(0, -3))

Obviously this just places ABC0001 in each cell in column D so I am looking for how I can ensure each value is the next consecutive number.

Thanks.

 

[Peter_SSs]

This is how I would approach it (unless you have many thousands of rows)

Sub AssignCodes()
  Dim InterimCode As String
  Dim n As Long
  Dim c As Range
  
  InterimCode = InputBox("Please enter code for Interim Number")
  For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
    If c.Value = "New" Then
      n = n + 1
      c.Offset(, 3).Value = InterimCode & Format(n, "0000")
    End If
  Next c
End Sub

 

[dave3009]

You could probably achieve this with a worksheet function.

Excel 2007
	A	B	C
1	A	D	ABC
2	New	ABC0001	ABC0001
3	Old
4	Changed
5	Old
6	New	ABC0002	ABC0002
7	New	ABC0003	ABC0003
8	Old
9	New	ABC0004	ABC0004
Sheet1

Cell Formulas
Range	Formula
C2	=IF(A2<>"New","",$C$1&TEXT(COUNTIF($A$2:A2,"New"),"0000"))

 

[schielrn]

Why do you need a macro to do this?

You can use a formula?

Excel Workbook
	A	B	C
1	New	ABC0001	ABC0001
2	Old
3	Changed
4	Old
5	New	ABC0002	ABC0002
6	New	ABC0003	ABC0003
7	Old
8	New	ABC0004	ABC0004
9	New		ABC0005
10	New		ABC0006
11	New		ABC0007
12	New		ABC0008
13	New		ABC0009
14	New		ABC0010
15	New		ABC0011
16	New		ABC0012
Sheet1

Cell Formulas
Range	Formula
C1	=IF(A1="New","ABC"&TEXT(COUNTIF($A$1:A1,A1),"000#"),"")

You could also replace ABC with a cell reference if you want. Or this can be converted into a macro if you really need a macro.

 

[meadscarla]

Thanks all.
Peter your code worked perfectly.

It needed a macro as there are a whole host of other functions taking place on a large amount of data coming from multiple sources.
This was just a very small part of it that I couldn't figure out.