Separation of compound names, within the name

[shimaa01234]

Can you separate the compound names in Arabic
Such as:
Abdel Rahman, Abdel Massih
Using the formula
Separation of compound names, within the name,
Name the compound so that, in a single column
And the rest, all in the name of a separate column
Like this table

Mohammed Abdel Rahman Bayoumi	Mohammed	Abdel Rahman	Bayoumi
Abdel Rahim Mustafa Tayeb	Abdel Rahim	Mustafa	Tayeb
Elias Abdel Massih Charles	Elias	Abdel Massih	Charles

<tbody>
</tbody>

 

[István Hirsch]

You are welcome, thanks for the feedback.

 

[shimaa01234]

How to add other names to this code
I tried to add names, such as the way in the existing code, but give me the result of an error
Unfortunately, again

 

[István Hirsch]

How to add other names to this code
I tried to add names, such as the way in the existing code, but give me the result of an error
Unfortunately, again

This discussion will be continued as soon as I get all of these data:

- I provided 3 solutions for the name-patterns available so far, which solution are you using (number of the post)?
- How did you try to add new names and what happened?
- If the new names represent new name-patterns how should they be separated?

 

[shimaa01234]

I want add to the name "Abd,Alaa"
"Abu" That's all

 

[shimaa01234]

Mister "Istvan"
The formula works nicely
But I tried, the use of code, and add a few names like this

Sub Sepnames()
Dim c As Range
Dim lc, uc As String
'For example:
lc = "a21" 'First cell
uc = "a29" 'Last cell
For Each c In ActiveSheet.Range(lc, uc)
c.Offset(, 1) = Replace(Replace(Replace(c, " ", ";"), "Abd;", "Abd "), "Alaa;", "Alaa "), "Abou;", "Abou ")
Next
Application.DisplayAlerts = False
Range(lc, uc).Offset(, 1).Select
Selection.TextToColumns Destination:=Range(lc).Offset(, 1), DataType:=xlDelimited, _
semicolon:=True
Application.DisplayAlerts = True
End Sub


But it showed an error
I'm sorry I come back again, after the end of the discussion

 

[István Hirsch]

Mister "Istvan"
The formula works nicely
But I tried, the use of code, and add a few names like this

Sub Sepnames()
Dim c As Range
Dim lc, uc As String
'For example:
lc = "a21" 'First cell
uc = "a29" 'Last cell
For Each c In ActiveSheet.Range(lc, uc)
c.Offset(, 1) = Replace(Replace(Replace(c, " ", ";"), "Abd;", "Abd "), "Alaa;", "Alaa "), "Abou;", "Abou ")
Next
Application.DisplayAlerts = False
Range(lc, uc).Offset(, 1).Select
Selection.TextToColumns Destination:=Range(lc).Offset(, 1), DataType:=xlDelimited, _
semicolon:=True
Application.DisplayAlerts = True
End Sub


But it showed an error
I'm sorry I come back again, after the end of the discussion

If you want to process another part of column A, you have to set the first cell (green) and the last cell (blue) of the range to process. For example, if the first cell is A2 then change the green value to A2 in line 5:

lc = "a2" 'First cell

and if the last cell is, for example, A1500 then set the last cell to process in line 6:

uc = "a1500" 'Last cell

Do not forget to save the workbook as .xlsm.

Sub Sepnames()
Dim c As Range
Dim lc, uc As String
'For example:
lc = "[B][COLOR=#006400]a21[/COLOR][/B]"   'First cell
uc = "[B][COLOR=#0000cd]a29[/COLOR][/B]"   'Last cell
        For Each c In ActiveSheet.Range(lc, uc)
          c.Offset(, 1) = Replace(Replace(Replace(c, " ", ";"), "Abd;", "Abd "), "Alaa;", "Alaa ")
        Next
    Application.DisplayAlerts = False
    Range(lc, uc).Offset(, 1).Select
    Selection.TextToColumns Destination:=Range(lc).Offset(, 1), DataType:=xlDelimited, _
    semicolon:=True
    Application.DisplayAlerts = True
End Sub

Let me know if it works now.

 

[shimaa01234]

But I tried, the use of code, and add a few names like this

c.Offset(, 1) = Replace(Replace(Replace(c, " ", ";"), "Abd;", "Abd "), "Alaa;", "Alaa "), "Abou;", "Abou ")
But it showed an error

 

[István Hirsch]

But I tried, the use of code, and add a few names like this

c.Offset(, 1) = Replace(Replace(Replace(c, " ", ";"), "Abd;", "Abd "), "Alaa;", "Alaa "), "Abou;", "Abou ")
But it showed an error

If you want to add „Abou” because this word has the same role az „Abd” or „Alaa”, inserting the new word to the end of the line is not enough, the beginning of the line also has to be changed like this (note the added Replace function):

Sub Sepnames()
Dim c As Range
Dim lc, uc As String
'For example:
lc = "a1" 'First cell
uc = "a9" 'Last cell
For Each c In ActiveSheet.Range(lc, uc)
c.Offset(, 1) = Replace(Replace(Replace(Replace(c, " ", ";"), "Abd;", "Abd "), "Alaa;", "Alaa "), "Abou;", "Abou ")
Next
Application.DisplayAlerts = False
Range(lc, uc).Offset(, 1).Select
Selection.TextToColumns Destination:=Range(lc).Offset(, 1), DataType:=xlDelimited, _
semicolon:=True
Application.DisplayAlerts = True
End Sub

Excel Workbook
	A	B	C	D	E
1	Abd Rahman Samir Ali	Abd Rahman	Samir	Ali
2	Abd Allah Ibrahim Marzouki	Abd Allah	Ibrahim	Marzouki
3	Samira Syed Abd ElMomin	Samira	Syed	Abd ElMomin
4	Alaa ElDin Mohamed Ali	Alaa ElDin	Mohamed	Ali
5	Peter Michel Abd ElMassih	Peter	Michel	Abd ElMassih
6	Abd Elaziz Ibrahim Abd Elrahman	Abd Elaziz	Ibrahim	Abd Elrahman
7	Abd Elaziz Ibrahim Abd Elrahman Mohammed	Abd Elaziz	Ibrahim	Abd Elrahman	Mohammed
8	Abd ElRahman Abd ElAziz Mohammed Ibrahim	Abd ElRahman	Abd ElAziz	Mohammed	Ibrahim
9	Abou Syed Abd ElMomin	Abou Syed	Abd ElMomin
Sheet

 

[shimaa01234]

Wonderful
Code is excellent, and the formula Genius
Thank you very much
And unfortunately for the time you spent with me for Educational
Thanks again, you're a nice guy