Consulting

Results 1 to 11 of 11

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

  1. #1

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

    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.
    Attached Files Attached Files
    Last edited by swaggerbox; 11-15-2019 at 03:21 AM.

  2. #2
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,639
    Please post a representative workbook.

  3. #3
    I just attached it snb

  4. #4
    VBAX Master paulked's Avatar
    Joined
    Apr 2006
    Posts
    1,007
    Location
    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.
    Semper in excretia sumus; solum profundum variat.

  5. #5
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,872
    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 Sub
    If 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.
    Last edited by p45cal; 11-15-2019 at 04:14 PM.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  6. #6
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,639
    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

  7. #7
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,872
    ...which will also change the likes of blacklist to graylist.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  8. #8
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,639
    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

  9. #9
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,872
    Quote Originally Posted by swaggerbox View Post
    to search if it contains words listed
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  10. #10
    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.

  11. #11
    VBAX Master paulked's Avatar
    Joined
    Apr 2006
    Posts
    1,007
    Location
    You're welcome
    Semper in excretia sumus; solum profundum variat.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •