Removing Duplicates in a single cell with multiple separator

[JezaDominic]

Hi I'm having a helluva time with excel since I remove duplicates from 33k row of entries from column A to P
Now I came across an issue, I need to merge multiple address in a single file row how ever each entry have multiple name, I need help in removing those multiple names after merging.
Below is an example, Each row has a merged duplicate entry per cell, the duplicated need to be remove but after running macros it seems that it does not work per cell.

1825 12664

1186 Holly Ave 3415 Beech St

Imperial Beach San Diego

United States Of America United States Of America

1220 Pacific Hwy #241 1220 Pacific Hwy #241

San Diego San Diego

CA CA

92101 92101

11777 26250

321-27 Imperial Ave 5321 Imperial Ave

San Diego San Diego

United House Of Prayer For United House Of Prayer For

3200 Freedom Dr 3200 Freedom Dr

Charlotte Charlotte

NC NC

28208 28208

28580 3043 17622

6707 Amherst St 1328 Hoover Ave 41 E 6th St

San Diego National City National City

United Brokers Realty Inc United Brokers Realty Inc United Brokers Realty Inc

Cooper Scafani & Assocs

5155 Waring Rd 5155 Waring Rd 5155 Waring Rd

San Diego San Diego San Diego

CA CA CA

92120 92120 92120

8328 12180

2330 Grove Ave 330-56 Grove Ave

San Diego San Diego

Unison Investments Unison Investments

Jen-Liang Wu - Ptr. Jen-Liang Wu - Ptr.

23545 Crenshaw Bl #201 23545 Crenshaw Bl #201

Torrance Torrance

CA CA

90505 90505

<tbody>
</tbody>

 

[Paulo L]

It's hard to visualize what you are trying to do. Can you create a simple example of before and after, showing what you are trying to achieve?

 

[JezaDominic]

Thanks you for your quick responce here is an example of the after, using the example above.

	Address 1			Owner.Name	Owner.Company	Owner.Address 1
1825	1186 Holly Ave	Imperial Beach		United States Of America		1220 Pacific Hwy #241		San Diego	CA	92101
12664	3415 Beech St	San Diego
11777	321-27 Imperial Ave	San Diego		United House Of Prayer For		3200 Freedom Dr		Charlotte	NC	28208
26250	5321 Imperial Ave	San Diego
28580	6707 Amherst St	San Diego		United Brokers Realty Inc	Cooper Scafani & Assocs	5155 Waring Rd		San Diego	CA	92120
3043	1328 Hoover Ave	National City
17622	41 E 6th St	National City
8328	2330 Grove Ave	San Diego		Unison Investments	Jen-Liang Wu - Ptr.	23545 Crenshaw Bl #201		Torrance	CA	90505
12180	330-56 Grove Ave	San Diego

<colgroup><col><col><col span="2"><col><col><col><col span="4"></colgroup><tbody>
</tbody>

I really would appreciate your help.. TIA

 

[JezaDominic]

Paulo L thanks your quick reponse

Below is what I'm trying to achieve.

	Address 1			Owner.Name	Owner.Company	Owner.Address 1
1825	1186 Holly Ave	Imperial Beach		United States Of America		1220 Pacific Hwy #241		San Diego	CA	92101
12664	3415 Beech St	San Diego
11777	321-27 Imperial Ave	San Diego		United House Of Prayer For		3200 Freedom Dr		Charlotte	NC	28208
26250	5321 Imperial Ave	San Diego
28580	6707 Amherst St	San Diego		United Brokers Realty Inc	Cooper Scafani & Assocs	5155 Waring Rd		San Diego	CA	92120
3043	1328 Hoover Ave	National City
17622	41 E 6th St	National City
8328	2330 Grove Ave	San Diego		Unison Investments	Jen-Liang Wu - Ptr.	23545 Crenshaw Bl #201		Torrance	CA	90505
12180	330-56 Grove Ave	San Diego

<colgroup><col><col><col span="2"><col><col><col><col span="5"></colgroup><tbody>
</tbody>

I'd really appreciate your help on this.

 

[JezaDominic]

I tried running this but Its prompting me out of range
Sub Remove_DupesInString()
Dim str As String
Dim fval As String
Dim strArr() As String
Dim x As Long
Dim k As Long
Set sht = Sheets("Sheet1")
Lastrow = sht.Cells(Cells.Rows.Count, "P99999").End(xlUp).Row
For Each cell In sht.Range("$B$2:P" & Lastrow)
Erase strArr
fval = ""
str = cell.Value
strArr = Split(str, "/")
For rw = 0 To UBound(strArr)
For k = rw + 1 To UBound(strArr)
If Trim(strArr(k)) = Trim(strArr(rw)) Then
strArr(k) = "" 'if duplicate clear array value
End If
Next k
Next rw
For x = 0 To UBound(strArr)
If strArr(x) <> "" Then
fval = fval & Trim(strArr(x)) & "/"
End If
Next x
fval = Left(fval, Len(fval) - 1)
cell.Value = fval
Next cell
End Sub