Convert duplicate number / reference unique if is 8 or less digits

Panoos64 · Oct 8, 2019

All hi, Kindly require to provide me a support so that a VBA code to run through col. “C” and where the first 8 digits and less from left side are common, should place by alphabetical method a letter and space on left. Note that the first common number/reference should remain unaffected and should star to place letter from second one. I present below original data and expected result.

Therefore that my below presentation are not on right alignment and however should be straight and middle.

Thank you all in advance

Original data

	A	B	C
1	DATE	TR. TYPE	REFERENCE
2	23/09/2019	INVOICE	8957UH056726
3	24/09/2019	INVOICE	564278
4	24/09/2019	CR. NOTE	564278
5	22/09/2019	INVOICE	TGF112133471
6	23/09/2019	INVOICE	TGF11213T340
7	24/09/2019	CR. NOTE	1425367889
8	25/09/2019	INVOICE	52457896T128
9	26/09/2019	INVOICE	524578961428
10	26/09/2019	INVOICE	52457896G121
11	27/09/2019	CR. NOTE	00000000141
12	29/09/2019	INVOICE	00000000252
13	29/09/2019	INVOICE	00000000458

Expected result

	A	B	C
1	DATE	TR. TYPE	REFERENCE
2	23/09/2019	INVOICE	8957UH056726
3	24/09/2019	INVOICE	564278
4	24/09/2019	CR. NOTE	A 564278
5	22/09/2019	INVOICE	TGF112133471
6	23/09/2019	INVOICE	A TGF11213T340
7	24/09/2019	CR. NOTE	1425367889
8	25/09/2019	INVOICE	52457896T128
9	26/09/2019	INVOICE	A 524578961428
10	26/09/2019	INVOICE	B 52457896G121
11	27/09/2019	CR. NOTE	00000000141
12	29/09/2019	INVOICE	A 00000000252
13	29/09/2019	INVOICE	B 00000000458

Peter_SSs · Oct 8, 2019

Give this a try

Rich (BB code):

Sub AddLetters()
  Dim a As Variant
  Dim i As Long
  Dim d As Object
  Dim s As String
  
  Set d = CreateObject("Scripting.Dictionary")
  a = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    s = Left(a(i, 1), 8)
    If d.exists(s) Then
      a(i, 1) = Chr(d(s) + 1) & " " & a(i, 1)
      d(s) = d(s) + 1
    Else
      d(s) = 64
    End If
  Next i
  Range("C2").Resize(UBound(a)).Value = a
End Sub

Panoos64 · Oct 8, 2019

Thank you Peter! it works perfect. Thank you once again for your continued support. Have a great day!

Peter_SSs · Oct 8, 2019

Panoos64 said:
Thank you Peter! it works perfect. Thank you once again for your continued support. Have a great day!

Cheers.

Convert duplicate number / reference unique if is 8 or less digits

Panoos64

Well-known Member

Excel Facts

Peter_SSs

MrExcel MVP, Moderator

Panoos64

Well-known Member

Peter_SSs

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

Convert duplicate number / reference unique if is 8 or less digits

Panoos64

Well-known Member

Excel Facts

Peter_SSs

MrExcel MVP, Moderator

Panoos64

Well-known Member

Peter_SSs

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock