Replacement Problem

[YasserKhalil]

Hello

I have the following code that I use to replace some text with a nother

Sub Replacement()
    Dim LastRow As Long
    LastRow = Sheets("Conditions").Cells(Rows.Count, "A").End(xlUp).Row
      For x = 1 To LastRow
          Cells.Replace What:=Sheets("Conditions").Range("A" & x), Replacement:=Sheets("Conditions").Range("B" & x), _
          Lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:= _
          False, ReplaceFormat:=False
      Next x
End Sub

If I want to replace for example (John Smith) with (Axel Smith)... There is no problem
But I found that the text (Johny Smith) is replaced with (Axely Smith) .. This is the problem.>>> I want to keep Johny as it is but replace just John

 

[YasserKhalil]

thank you very much for your great effort and great help Mr. Rick
It worked well now but there is a little problem .. The code replaces the whole cell :::
i.e "John Smith" became "Axel" not "Axel Smith"

 

[YasserKhalil]

How can I solve this problem of your code Mr. Rick?

 

[YasserKhalil]

UP
Please help me

 

[Rick Rothstein]

How can I solve this problem of your code Mr. Rick?

The problem is in your (original) code and/or cell values, not in the code I gave you. Here is the code I proposed...

Sub Replacement()
      Dim LastRow As Long
      LastRow = Sheets("Conditions").Cells(Rows.Count, "A").End(xlUp).Row
        For x = 1 To LastRow
              If InStrExact(1, Sheets("Data").Range("B" & x), Sheets("Conditions").Range("A" & x), True) Then
                    Cells.Replace What:=Sheets("Data").Range("A" & x), _
                                  Replacement:=Sheets("Conditions").Range("B" & x), _
                                  Lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, _
                                  SearchFormat:=False, ReplaceFormat:=False
              End If
        Next x
End Sub

The only part that I added is highlighted in red... the rest of the code is just a copy of what you posted originally. My InStrExact function call does not perform any changes to your worksheet, it only returns a number if the text being searched for stands alone in the cell you are searching... it does not physically change anything on the worksheet... those changes are performed by the code that you posted (which I simply copied and rearranged a little bit for appearance purposes). So, if the code is not doing what you want, it is because something is wrong with your code and/or the values in your cells that your code is working with. Since I cannot see the cell values, I cannot comment further on what might be wrong. I will point out, though, that your original message suggested your code worked differently than the way you are now reporting it works.

 

[YasserKhalil]

Thanks a lot Mr. Rick for your great help.
I really can't do it.

I will explain my request in simple words again.......

I have two sheets first named "Data", second named "Conditions"

In Conditions sheet A1 I put the text "John" and in B1 I put "Axel". In A2 I put "Dog" and in B2 I put "Cat" and so on in other cells :: A1 represents the value that I want to replace and B1 represents the new value that I want. So I named this sheet "Conditions".

In Data sheet there is data in column A (A1:A100)
For example A1 John Smith
A2 Johny Smith

I want to replace just "John" with "Axel" not "Johny" with "Axely"
So the results should be like that :
A1 Axel Smith
A2 Johny Smith

I hope that it is clear now
I appreciate your effort Mr. Rick

I

 

[Rick Rothstein]

Thanks a lot Mr. Rick for your great help.
I really can't do it.

I will explain my request in simple words again.......

I have two sheets first named "Data", second named "Conditions"

In Conditions sheet A1 I put the text "John" and in B1 I put "Axel". In A2 I put "Dog" and in B2 I put "Cat" and so on in other cells :: A1 represents the value that I want to replace and B1 represents the new value that I want. So I named this sheet "Conditions".

In Data sheet there is data in column A (A1:A100)
For example A1 John Smith
A2 Johny Smith

I want to replace just "John" with "Axel" not "Johny" with "Axely"
So the results should be like that :
A1 Axel Smith
A2 Johny Smith

I hope that it is clear now

Yes, it is clear now (you should have posted this description in your original message). Give this code a try...

Sub Replacement()
  Dim x As Long, LastRow As Long, Position As Long, FindMe As String, ReplaceWith As String, CellText As String
  FindMe = InputBox("What word do you want to find and replace?")
  On Error GoTo NoSuchWord
  ReplaceWith = Worksheets("Conditions").Columns("A").Find(FindMe, LookAt:=xlPart, MatchCase:=True).Offset(, 1).Value
  With Worksheets("Data")
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    For x = 1 To LastRow
      Position = InStrExact(1, .Cells(x, "A").Value, FindMe, True)
      CellText = .Cells(x, "A").Value
      Do While Position
        Mid(CellText, Position, Len(FindMe)) = ReplaceWith
        Position = InStrExact(Position + 1, .Cells(x, "A").Value, FindMe, True)
      Loop
      .Cells(x, "A").Value = CellText
    Next
  End With
  Exit Sub
NoSuchWord:
  MsgBox "Sorry, but I cannot find the word """ & FindMe & """ on the Conditions sheet."
End Sub

Function InStrExact(Start As Long, SourceText As String, WordToFind As String, _
                    Optional CaseSensitive As Boolean = False, _
                    Optional AllowAccentedCharacters As Boolean = False) As Long
  Dim x As Long, Str1 As String, Str2 As String, Pattern As String
  Const UpperAccentsOnly As String = "ÇÉÑ"
  Const UpperAndLowerAccents As String = "ÇÉÑçéñ"
  If CaseSensitive Then
    Str1 = SourceText
    Str2 = WordToFind
    Pattern = "[!A-Za-z0-9]"
    If AllowAccentedCharacters Then Pattern = Replace(Pattern, "!", "!" & UpperAndLowerAccents)
  Else
    Str1 = UCase(SourceText)
    Str2 = UCase(WordToFind)
    Pattern = "[!A-Z0-9]"
    If AllowAccentedCharacters Then Pattern = Replace(Pattern, "!", "!" & UpperAccentsOnly)
  End If
  For x = Start To Len(Str1) - Len(Str2) + 1
    If Mid(" " & Str1 & " ", x, Len(Str2) + 2) Like Pattern & Str2 & Pattern Then
      InStrExact = x
      Exit Function
    End If
  Next
End Function

Note, I have included my function, so the above code is complete unto itself... all you have to do is run the Replacement macro. Also note that the above code can correctly handle multiple replacements within a single cell. For example, this text...

John Jones, Johnny Jackson and John Johnson

becomes this...

Axel Jones, Johnny Jackson and Axel Johnson

 

[YasserKhalil]

great great fantastic Mr. Rick
Last thing I don't want inputbox. I want to execute the code based on the sheet "Conditions".
There are a lot of replacement process
I need to do all the replacements alltogether

not just "John" with "Axel"
there are a lot of occurences

 

[Rick Rothstein]

great great fantastic Mr. Rick
Last thing I don't want inputbox. I want to execute the code based on the sheet "Conditions".
There are a lot of replacement process
I need to do all the replacements alltogether

not just "John" with "Axel"
there are a lot of occurences

Okay, give this a try (replace all the code I gave you in my last message with the following code)...

Sub Replacement()
  Dim x As Long, LastRow As Long, Position As Long, FindMe As Range, ReplaceWith As String, CellText As String
  For Each FindMe In Worksheets("Conditions").Range("A1").Resize(Cells(Rows.Count, "A").End(xlUp).Row)
    On Error GoTo Continue
    ReplaceWith = Worksheets("Conditions").Columns("A").Find(FindMe, LookAt:=xlPart, MatchCase:=True).Offset(, 1).Value
    With Worksheets("Data")
      LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
      For x = 1 To LastRow
        Position = InStrExact(1, .Cells(x, "A").Value, FindMe.Value, True)
        CellText = .Cells(x, "A").Value
        Do While Position
          Mid(CellText, Position, Len(FindMe)) = ReplaceWith
          Position = InStrExact(Position + 1, .Cells(x, "A").Value, FindMe.Value, True)
        Loop
        .Cells(x, "A").Value = CellText
      Next
    End With
Continue:
    Resume Next
  Next
End Sub

Function InStrExact(Start As Long, SourceText As String, WordToFind As String, _
                    Optional CaseSensitive As Boolean = False, _
                    Optional AllowAccentedCharacters As Boolean = False) As Long
  Dim x As Long, Str1 As String, Str2 As String, Pattern As String
  Const UpperAccentsOnly As String = "ÇÉÑ"
  Const UpperAndLowerAccents As String = "ÇÉÑçéñ"
  If CaseSensitive Then
    Str1 = SourceText
    Str2 = WordToFind
    Pattern = "[!A-Za-z0-9]"
    If AllowAccentedCharacters Then Pattern = Replace(Pattern, "!", "!" & UpperAndLowerAccents)
  Else
    Str1 = UCase(SourceText)
    Str2 = UCase(WordToFind)
    Pattern = "[!A-Z0-9]"
    If AllowAccentedCharacters Then Pattern = Replace(Pattern, "!", "!" & UpperAccentsOnly)
  End If
  For x = Start To Len(Str1) - Len(Str2) + 1
    If Mid(" " & Str1 & " ", x, Len(Str2) + 2) Like Pattern & Str2 & Pattern Then
      InStrExact = x
      Exit Function
    End If
  Next
End Function

 

[YasserKhalil]

Mr. Rick you are a great man. You are very patient with me.
Although the problem is still there, I'm very grateful to you for your great help.

The code doesn't match my request..
-------------
For more explanation : Conditions sheet

John	Axel
Dog	Cat
Fahd	Fares
Sally	Samy

<tbody>
</tbody>

for each value in column A if found in the text in Data sheet .. should be replaced with the value in Column B
--------------
Data Sheet

John Smith

Johny Smith

Dog HHH

Sally Danny

Doggy HH

<tbody>
</tbody>

This is the sheet that I want to do the work on it.
The results in Data Sheet should be as following:

Axel Smith

Johny Smith

Cat HHH

Samy Danny

Doggy HH

<tbody>
</tbody>

 

[Rick Rothstein]

Mr. Rick you are a great man. You are very patient with me.
Although the problem is still there, I'm very grateful to you for your great help.

The code doesn't match my request..
-------------
For more explanation : Conditions sheet

John	Axel
Dog	Cat
Fahd	Fares
Sally	Samy

<tbody>
</tbody>

for each value in column A if found in the text in Data sheet .. should be replaced with the value in Column B
--------------
Data Sheet

John Smith

Johny Smith

Dog HHH

Sally Danny

Doggy HH

<tbody>
</tbody>

This is the sheet that I want to do the work on it.
The results in Data Sheet should be as following:

Axel Smith

Johny Smith

Cat HHH

Samy Danny

Doggy HH

<tbody>
</tbody>

That is exactly the output I get in the test data that I set up. Obviously, you data is setup differently in some way than I am able to figure out from what you have posted. Here is what my setup looks like... tell me where your setup differs from it.

Conditions

	A	B	C
1	John	Axel
2	Dog	Cat
3	Fahd	Fares
4	Sally	Samy
5

<colgroup>
<col style="width: 30px; font-weight: bold;">
<col style="width: 69px;">
<col style="width: 69px;">
<col style="width: 69px;"></colgroup>
<tbody>

</tbody>

Data

	A	B
1	John Smith
2	Johny Smith
3	Dog HHH
4	Sally Danny
5	Doggy HH
6

<colgroup>
<col style="width: 30px; font-weight: bold;">
<col style="width: 98px;">
<col style="width: 114px;"></colgroup>
<tbody>

</tbody>