Very tricky Find and Replace Strings - VBA code needed!

[actjfc]

Excel Friends:

I have list of strings in one Column, i.e. Column A, with a variable number of rows. Also, I have a Table of two columns filled with strings in each cell, let’s say Column C, and D, with a variable number of rows. The idea of the VBA macro that I would like to get help is this:

The macro should loops throughout the whole column A, any time any of the strings in a cell in Column C of the table appears inside any of the strings in column A, then the macro goes on creating a copy of the column A, in Column F, but replacing the string found with the value in Column D in the same row of the table.

For example:
Column A:The House is red
Column C - D:
House - Split Level
Red - White

Column F: The Split Level is white.

It needs to loop hundreds of rows

Thanks for any help!

 

[Peter_SSs]

Mike, wouldn't you also need a "." in front of each of those Ranges in case Sheet1 is not the active sheet?

With Sheets("Sheet1")
    Set StartCol = [COLOR="#FF0000"][B][SIZE=4].[/SIZE][/B][/COLOR]Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
'...
End With

 

[portews]

Here's my entry. It loops thru the A rows, creates a copy in F then loops thru all the possible replacement words in B looking for a match in F, then replaces it with the adjacent word C.

Sub substitutewords()
Dim sht As Worksheet
Set sht = ActiveSheet


lastrowA = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
lastrowB = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row
For i = 2 To lastrowA
    Cells(i, 6) = Cells(i, 1)
    For j = 2 To lastrowB
        If InStr(1, LCase(Cells(i, 6)), LCase(Cells(j, 2))) Then
            Cells(i, 6) = Replace(Cells(i, 6), Cells(j, 2), Cells(j, 3))
        End If
    Next j
Next i
End Sub

 

[Peter_SSs]

Here's my entry.

My comments:
1. You force similar comparison in the InStr line by using LCase for each string, however, in the Replace line, you don't specify the vbTextCompare argument so replacements may not actually be performed, depending on the upper/lower case of the original data and the find/replace column.

2. If the above problem is addressed, or not applicable, then your code has the same potential problem that I mentioned in post #9

.. code will convert
The house is colored red
into
The Split Level is coloWhite White

 

[actjfc]

Thanks to all of you for your help. I am learning nice VBA tricks. So far I will keep Peter_SSs solution. I must say it works almost* perfectly, but I cannot understand the logic of Regular Expressions. I think that understanding RegExp is a different kind of skill from VBA by itself. Thanks it is very neat!

*Something it is puzzling for me: If the string in a cell in Column C is for example 1-1/2" (“ inches), if I want to replace it with 1-1/4", it does not work. Everything else works perfect.

 

[Peter_SSs]

I think that understanding RegExp is a different kind of skill from VBA by itself.

It does take a bit to get your head around it.

*Something it is puzzling for me: If the string in a cell in Column C is for example 1-1/2" (“ inches), if I want to replace it with 1-1/4", it does not work. Everything else works perfect.

The issue (or at least one of them) is that my regexp pattern was using "\b" which looked for a "word boundary" at the start and end of the value to be replaced. That is how I was avoiding the problem mentioned in post #9. However 1-1/2" is not a "word" as such and regexp identifies additional "word boundaries" before and after the "-" in the blue text for example.

You could try this version that attempts to use space characters to identify the "words". I believe that we still do need something as a delimiter so that if we are looking to replace 1-1/2" we don't replace the underlined part of this text 21-1/2"

[color=darkblue]Sub[/color] Do_Replacements_v2()
  [color=darkblue]Dim[/color] RX [color=darkblue]As[/color] [color=darkblue]Object[/color]
  [color=darkblue]Dim[/color] aData [color=darkblue]As[/color] [color=darkblue]Variant[/color], aReplacements [color=darkblue]As[/color] [color=darkblue]Variant[/color]
  [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color], j [color=darkblue]As[/color] Long
  [color=darkblue]Dim[/color] s [color=darkblue]As[/color] [color=darkblue]String[/color]
  
  [color=darkblue]Set[/color] RX = CreateObject("VBScript.RegExp")
  RX.Global = [color=darkblue]True[/color]
  RX.IgnoreCase = [color=darkblue]True[/color]
  aData = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  aReplacements = Range("C1", Range("D" & Rows.Count).End(xlUp)).Value
  [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](aData)
    s = " " & Replace(aData(i, 1), " ", "  ") & " "
    [color=darkblue]For[/color] j = 1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](aReplacements)
      RX.Pattern = "( )(" & aReplacements(j, 1) & ")( )"
      s = RX.Replace(s, "$1" & aReplacements(j, 2) & "$3")
    [color=darkblue]Next[/color] j
    aData(i, 1) = Application.Trim(s)
  [color=darkblue]Next[/color] i
  Range("F1").Resize(UBound(aData)).Value = aData
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[actjfc]

Thanks! It works perfect with spaces. The actual strings are crammed and separate by commas. The only issue is that the strings between commas may be like:

The House is Red,The measure is 1-1/2",The dog is cute,... no spaces before or after the commas!

In this example I may need to replace "measure" for "size", and 1-1/2" for 1-1/4". Can you make the needed changes?

I also have been testing the VBA function Replace, but it does not recognize the patterns like 1-1/2". In my non expert opinion, using Replace is a simplistic approach than using RegExp. It is excellent to use RegExp, but the code is not easy to understand or modify for me. Thanks again!

 

[Peter_SSs]

Is it only commas, or could there be "." or "!" or "?" etc?

vba Replace can be used to replace 1-1/2" but ..
a) It is a bit trickier, and
b) You have the problem of stopping the replacement in text like the red text in my previous post.

 

[actjfc]

The data will be separated for only commas. No spaces in between commas. The idea of the macro is replacing the strings and substrings within the commas with shorter strings that will make the overall length of the resulting cell content shorter than a given "X" count of characters. Peter_SSs, once your macro is done. I think I can take care of calculating and identifying compliance of the final count of characters of the resulting cells. This is great. Thanks!

 

[István Hirsch]

If you need further support you can choose from Advanced Find and Replace programs which have a lot of options like search in forders/subfolders, case sensitive search, whole words only, search with And and Or function, search for Phrases, Regexp, batch replace, Undo etc.

 

[Peter_SSs]

The data will be separated for only commas.

Does this do what you want? If not, please supply a couple of examples of original text, replacement values from columns C:D & expected results.

Sub Do_Replacements_v3()
  Dim RX As Object
  Dim aData As Variant, aReplacements As Variant
  Dim i As Long, j As Long
  Dim s As String
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  aData = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  aReplacements = Range("C1", Range("D" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(aData)
    s = " " & Replace(Replace(aData(i, 1), ",", " , "), " ", "  ") & " "
    For j = 1 To UBound(aReplacements)
      RX.Pattern = "( )(" & aReplacements(j, 1) & ")( )"
      s = RX.Replace(s, "$1" & aReplacements(j, 2) & "$3")
    Next j
    aData(i, 1) = Replace(Application.Trim(s), " , ", ",")
  Next i
  Range("F1").Resize(UBound(aData)).Value = aData
End Sub