Match Text string and Remove Duplicates

[Pete2020]

I thank each and every Mr. Excel forum members who are helping hundreds of Productivity Issues daily.

I am looking for a solution to remove similar duplicates by identifying the Pattern which every text ends with a Number.

Based on Column A (primary key) - the macro should run on column B data, by matching the similar text name ends with a Number.It should trim the extra spaces and delete the numbers and special characters around it.

Later macro should delete the Column B duplicates based on column A and results should be populated in column D and E.

Sample data

Book7
	A	B	C	D	E
1	ID	RAW DATA		Primary	Remove duplicate and Keep Unique
2	CD-001	Toggle Method - 1		CD-001	Toggle Method
3	CD-001	Toggle Method - 2		CD-002	Update Action -part
4	CD-002	Update Action - Part 1		CD-003	Add Form - Part
5	CD-002	Update Action - Part 2		CD-004	Code Implementation
6	CD-003	Add Form - Part (1)		CD-005	Create and run a while loop, part
7	CD-003	Add Form : Part (2)		CD-006	VBA Framework Lecture
8	CD-004	Code Implementation I		CD-007	VBA Project Video
9	CD-004	Code Implementation II		CD-008	VBA Command Video
10	CD-005	Create and run a while loop, part 1		CD-009	Player Setup P
11	CD-005	Create and run a while loop, part 2		CD-010	The registerNewUser method part
12	CD-006	VBA Framework Lecture:-1		CD-011	HTML Form @ Part
13	CD-006	VBA Framework Lecture:-2		CD-012	VBA Function
14	CD-007	VBA Project Video - i		CD-013	Let's create Macro Pt
15	CD-007	VBA Project Video- ii		CD-014	Source Code Lesson
16	CD-008	VBA Command Video1		CD-015	VBA Functions - Chapter
17	CD-008	VBA Command Video 2		CD-016	Inbuilt Time Function
18	CD-009	Player Setup P.1		CD-016	Inbuilt Date Functions
19	CD-009	Player Setup P.2		CD-016	Inbuilt Text Functions
20	CD-010	The registerNewUser method part1
21	CD-010	The registerNewUser method part2
22	CD-011	HTML Form @ part2
23	CD-011	HTML Form @ part3
24	CD-012	VBA Functions 01
25	CD-012	VBA Functions02
26	CD-013	Let's create Macro Pt.1
27	CD-013	Let's create Macro Pt.2
28	CD-014	Source Code Lesson 28
29	CD-014	Source Code Lesson 29
30	CD-015	VBA Functions - Chapter-1
31	CD-015	VBA Functions - Chapter-2
32	CD-016	Inbuilt Time Function
33	CD-016	Inbuilt Date Functions
34	CD-016	Inbuilt Text Functions
Sheet1

 

[DanteAmor]

I encountered errors when running your code. Particularly this line y = Trim(Mid(c.Value, InStrRev(c.Value, " "), 5)) as some rows of the provided sample data (eg row 27 from post #12) do not contain a space character.

Thanks Peter_sss, excellent remarks, the code was for post #1, it is only to correct the code problem in post #3.
Now I see that there are more patterns that the OP had not mentioned in post #1. Glad to know you are here with a great macro to help the OP.

Just a little detail in your code, and I don't know if it's relevant, after the questions you asked the OP.
But in the first example of the OP, he has this data and the expected result:

Libro1
	A	B	C	D	E
1	ID	RAW DATA
2	CD-003	Add Form - Part (1)		CD-003	Add Form Part
3	CD-003	Add Form : Part (2)
Hoja1

But your code results in this:

Libro1
	A	B	C	D	E
1	ID	RAW DATA
2	CD-003	Add Form - Part (1)		CD-003	Add Form Part (1)
3	CD-003	Add Form : Part (2)		CD-003	Add Form Part (2)
Hoja1

But if it's an example that no longer exists in the OP data, then forget my comment.

Again I thank you for your time in reviewing my code and for sharing your knowledge.

 

[Pete2020]

I personally thank @Peter_SSs and @DanteAmor and Mr.Excel forum administrators for giving your time and effort in helping with your codes.

I regret myself in pulling all the relevant patterns from my records. But I appreciate your commitment in resolving the issues through code modification and effective engagement through out this thread.

@Peter_SSs I am learning a lot from you day by day.

Thank You

 

[Peter_SSs]

You're welcome. I assume that you are at or close to what you wanted in relation to this thread? Or maybe still testing?

Just a little detail in your code,...

But your code results in this:

Hi Dante
Thanks for picking that up.
At some point I have lost the correct dealing with numbers in parentheses at the end.

I'm hoping that this covers all the formats provided so far.

Sub AggregateParts_v2()
  Dim RX As Object, d As Object
  Dim a As Variant
  Dim i As Long
  
  Const Patt1 As String = "[\,:;\.\-@_#]"
  Const Patt2 As String = "([^a-z0-9][a-z])?(\((\d+|[civxl]+)\))|(\d+|[civxl]+)( *\([a-z]+\)){0,1}$"

  Set d = CreateObject("Scripting.Dictionary")
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  a = Range("A2", Range("B" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    RX.Pattern = Patt1
    a(i, 2) = Application.Trim(RX.Replace(a(i, 2), " "))
    RX.Pattern = Patt2
    If RX.Test(a(i, 2)) Then a(i, 2) = RTrim(RX.Replace(a(i, 2), ""))
    If a(i, 2) Like "* [a-zA-Z]" Then a(i, 2) = Left(a(i, 2), Len(a(i, 2)) - 2)
    d(a(i, 1) & ";" & a(i, 2)) = Empty
  Next i
  Application.ScreenUpdating = False
  With Range("D2").Resize(d.Count)
    .Value = Application.Transpose(d.Keys)
    .TextToColumns DataType:=xlDelimited, Semicolon:=True, Comma:=False, Space:=False, Other:=False
  End With
  Application.ScreenUpdating = True
End Sub

 

[Pete2020]

You're welcome. I assume that you are at or close to what you wanted in relation to this thread? Or maybe still testing?

Hi Dante
Thanks for picking that up.
At some point I have lost the correct dealing with numbers in parentheses at the end.

I'm hoping that this covers all the formats provided so far.

Sub AggregateParts_v2()
  Dim RX As Object, d As Object
  Dim a As Variant
  Dim i As Long
 
  Const Patt1 As String = "[\,:;\.\-@_#]"
  Const Patt2 As String = "([^a-z0-9][a-z])?(\((\d+|[civxl]+)\))|(\d+|[civxl]+)( *\([a-z]+\)){0,1}$"

  Set d = CreateObject("Scripting.Dictionary")
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  a = Range("A2", Range("B" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    RX.Pattern = Patt1
    a(i, 2) = Application.Trim(RX.Replace(a(i, 2), " "))
    RX.Pattern = Patt2
    If RX.Test(a(i, 2)) Then a(i, 2) = RTrim(RX.Replace(a(i, 2), ""))
    If a(i, 2) Like "* [a-zA-Z]" Then a(i, 2) = Left(a(i, 2), Len(a(i, 2)) - 2)
    d(a(i, 1) & ";" & a(i, 2)) = Empty
  Next i
  Application.ScreenUpdating = False
  With Range("D2").Resize(d.Count)
    .Value = Application.Transpose(d.Keys)
    .TextToColumns DataType:=xlDelimited, Semicolon:=True, Comma:=False, Space:=False, Other:=False
  End With
  Application.ScreenUpdating = True
End Sub

Almost Closed. Your help is more than expected.

Macro,is working fine on my 60k rows

 

[Peter_SSs]

Almost Closed. Your help is more than expected.

Macro,is working fine on my 60k rows

Good news, but post back with details if further issues arise.