Macro to create Sub-account numbers

[howard]

I import data and there are several account numbers in Col A on sheet "Imported data" that have the same account number that was downloaded from another program which stored the account number in one field and a sub-numbber in another field. When downloading the sub-field in not part of the download

I would like a macro to place a 01 to end of the number that appears a second time in Col A 02 to the number when it appears a second time 03 a third time etc etc eg if 7189 appears a second time 01 to be shown at the end 718901 , if it appears again 718902. If 7000 appears a second time 01 to be placed at the end 700001 a second time 700002 etc

Your assistance in this regard is most appreciated

 

[mirabeau]

I import data and there are several account numbers in Col A on sheet "Imported data" that have the same account number that was downloaded from another program which stored the account number in one field and a sub-numbber in another field. When downloading the sub-field in not part of the download

I would like a macro to place a 01 to end of the number that appears a second time in Col A 02 to the number when it appears a second time 03 a third time etc etc eg if 7189 appears a second time 01 to be shown at the end 718901 , if it appears again 718902. If 7000 appears a second time 01 to be placed at the end 700001 a second time 700002 etc

Your assistance in this regard is most appreciated

If your "numbers" really are numbers, then try the following code. Else a bit of modification.

Sub jxj()
Dim a, d As Object, i As Long

Set d = CreateObject("scripting.dictionary")
a = Cells(1).CurrentRegion.Resize(, 1)

For i = 1 To UBound(a, 1)
   If Not d.exists(a(i, 1)) Then
        d(a(i, 1)) = 0
   Else
        d(a(i, 1)) = d(a(i, 1)) + 1
        a(i, 1) = a(i, 1) * 100 + d(a(i, 1))
    End If
Next i

Cells(1).CurrentRegion.Resize(, 1) = a

End Sub

 

[howard]

Thanks for the reply. Have avtivated your macro, but where number (think it appears as text) appears motre than once 01 , 02 not added to the end of number

See sample data below

Excel Workbook
	A
7	7183
8	7183
9	7189
10	** TOTALS FOR
11	** Department: NEW VEHICLES
12	7183
13	7093
14	7158
15	** TOTALS FOR
16	** Department: SERVICE
17	7071
Page 1

 

[mirabeau]

Thanks for the reply. Have avtivated your macro, but where number (think it appears as text) appears motre than once 01 , 02 not added to the end of number

See sample data below
...
...

OK. Modified. Just the one line about 5th from bottom

Sub kxk()
Dim a, d As Object, i As Long

Set d = CreateObject("scripting.dictionary")
a = Cells(1).CurrentRegion.Resize(, 1)

For i = 1 To UBound(a, 1)
   If Not d.exists(a(i, 1)) Then
        d(a(i, 1)) = 0
   Else
        d(a(i, 1)) = d(a(i, 1)) + 1
        a(i, 1) = a(i, 1) & "0" & d(a(i, 1))
    End If
Next i
Cells(1).CurrentRegion.Resize(, 1) = a
End Sub

 

[howard]

Thanks for the reply-Still not adding 01 where same number appears a second time. Would it be possible for me to email you my file? IIf so send me a PM and I will email you my file

 

[mirabeau]

Thanks for the reply-Still not adding 01 where same number appears a second time. Would it be possible for me to email you my file? IIf so send me a PM and I will email you my file

Could be several reasons, mainly depending on your data setup.

If your data are in Column A then try the following modification. It it still doesn't do as you ask then it may be that your "duplicate numbers" are not duplicates. If text they may include non-printing characters such as spaces.

Sub lxxl() 'for howard

Dim a, d As Object, i As Long, rws As Long
Set d = CreateObject("scripting.dictionary")
rws = Cells(Rows.Count, "A").End(3).Row
a = Cells(1).Resize(rws)

For i = 1 To rws
    If Len(a(i, 1)) > 0 Then
        If Not d.exists(a(i, 1)) Then
            d(a(i, 1)) = 0
        Else
            d(a(i, 1)) = d(a(i, 1)) + 1
            a(i, 1) = a(i, 1) & "0" & d(a(i, 1))
        End If
    End If
Next i
Cells(1).Resize(rws) = a

End Sub

 

[Rick Rothstein]

Cross posted (with some answers) here...

Add Trailing Count Number For Each Duplicate Value

 

[mirabeau]

Cross posted (with some answers) here...

Add Trailing Count Number For Each Duplicate Value

Thanks for the info Rick.

Seems I may have been spending time on this thread (luckily not much) unnecessarily.


I know nothing about Excel Fox and don't really want to. The limited amount of Excel I do diverts me from too many other interesting things in life ...


So, quite happy to leave this one in your capable hands.


Good luck!

 

[howard]

Thanks for the help, it works perfectly (added sheets("import").select as I have several sheets)

I also have a sheets Fassets, that also has duplicate numbers that I need to add 01 at the end. However, the numbers are in column C. I tried copying your code to the end of the previous code and amending to suit my needs i.e Col C sheets (FASSETS), but cannot get it to work. It would be appreciated

Regards

Howard

 

[howard]

Hi Rick & Mirabeau

My apologies, I forgot to show that I had cross-posted, which I usually do

Regards

Howard