Search string if it contains words from a range then replace with adjacent cell

[swaggerbox]

In a Sheet1 Textbox1, I need to search if it contains words listed in Sheet2 and if it finds a match or multiple matches then replace part of the string in Textbox1 with the adjacent cell of the matched word (Sheet2 is formatted in two columns). To illustrate, supposed the string in Textbox1 is "The quick brown fox jumps over the lazy black dog". Then in sheet2 I have in column A the list of colors and in the column B the list of new colors:
Column A Column B
BROWN Light Brown
BLUE Sky Blue
YELLOW Amber Yellow
BLACK Gray
WHITE Dirty white

The words "brown" and "black" matches the string in column A. We need to replace "brown" with "Light brown" and "black" with "gray". The output should then "The quick light brown fox jumps over the lazy gray dog" in Textbox1.

Could someone point me in the right direction.

[snb]

Please post a representative workbook.

[swaggerbox]

I just attached it snb

[paulked]

Firstly, "brown" and "black" don't match anything on sheet 2. They come close to "Brown" and "Black". If you change the uppercase characters to lowercase then this non-elegant solution will work:



Sub test()
Dim arr As Variant, i As Long, j As Long, rw As Long, lr As Long, str As String, newstr As String
arr = Split(Sheet1.TextBox1.Text)
lr = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row
For i = 0 To UBound(arr)
str = Replace(arr(i), " ", "")
For rw = 1 To lr
If str = Sheet2.Cells(rw, 1) Then
newstr = newstr & Sheet2.Cells(rw, 2) & " "
j = 1
End If
Next
If j = 0 Then newstr = newstr & str & " "
j = 0
Next
Sheet1.TextBox1.Text = Left(newstr, (Len(newstr) - 1))
End Sub


If you think you'll have the first word of the sentence (eg Black is the new grey) then add "Black" and "Grey" onto Sheet2.

[p45cal]

Much the same as paulked's solution:
Sub blah()
Set rngTranslation = Sheets("Sheet2").Cells(1).CurrentRegion
TranslateFrom = rngTranslation.Columns(1).Value
TranslateTo = rngTranslation.Columns(2).Value
xx = Split(Application.Trim(Sheets("Sheet1").TextBox1.Text))
For i = 0 To UBound(xx)
cc = Application.Match(xx(i), TranslateFrom, 0)
If Not IsError(cc) Then xx(i) = Application.Index(TranslateTo, cc, 1)
Next i
Sheets("Sheet1").TextBox1.Text = Join(xx)
End SubIf you process the text more than once you'll get progreessively:
The quick brown fox jumps over the lazy black dog
The quick Light Brown fox jumps over the lazy Gray dog
The quick Light Light Brown fox jumps over the lazy Gray dog

Will there ever be more than one word in column A of Sheet2? If so we'll need to tweak.

[snb]

Sub M_snb()
sn = Sheet2.Cells(1).CurrentRegion

For j = 1 To UBound(sn)
Sheet1.TextBox1 = Replace(Sheet1.TextBox1, sn(j, 1), LCase(sn(j, 2)), , , 1)
Next
End Sub

[p45cal]

...which will also change the likes of blacklist to graylist.

[snb]

No part of the initial question.


Sub M_snb()
sn = Sheet2.Cells(1).CurrentRegion

For j = 1 To UBound(sn)
Sheet1.TextBox1 = Replace(Sheet1.TextBox1, " " & sn(j, 1) & " ", " " & LCase(sn(j, 2)) & " ", , , 1)
Next

Sheet1.TextBox1=trim(Sheet1.TextBox1)
End Sub

[p45cal]

to search if it contains words listed

[swaggerbox]

paulked, p45cal and snb: you just made my day. Thank you for all the help. I was away during the weekend and voila, i got the replies I wanted when got back to work today. thanks a lot.

[paulked]

You're welcome :beerchug: