Find and Replace Macro for Textbox from External Source

[vizgraphics]

Hello,
I have a large chunk of text that I need to find and replace a bunch of different values within. I have one file with columns for the find and replace values. I'm setting up a text box in a separate file that I will paste the large chunk of text to search through. I need the macro to open the external file, look through all the rows for anything in Column Q and replace with Column R. Here's where I'm at but I can't get the text to replace in the box:

Sub ConvertJobNumbers()    Dim NameListWB As Workbook, thisWb As Workbook
    Dim NameListWS As Worksheet, thisWs As Worksheet
    Dim i As Long, lRow As Long
    Dim shp As Object
    


    'This is the workbook from where your code is running
    Set thisWb = ThisWorkbook
    'This is the Sheet we are looking at to replace text in
    Set thisWs = thisWb.Sheets("Sheet1")


    'Open external file to find and replace from
    Set NameListWB = Workbooks.Open("jobMapping.xlsx")

    Set NameListWS = NameListWB.Worksheets("Sheet1")


    With NameListWS
        'Look for textboxes and other shapes
        For Each shp In thisWs.Shapes
        'Do the replace
            If shp.Name = "TextBox 1" Then
            shp.TextFrame.Characters.Text.Replace What:=.Range("Q" & i).Value, _
                                      Replacement:=.Range("R" & i).Value, _
                                      SearchOrder:=xlByColumns, _
                                      MatchCase:=False
        End If
       Next shp
    End With
End Sub

Any help would be appreciated

 

[mrmmickle1]

Hey vizgraphics,

Welcome to the board!

Try using Syntax Like this:

       [COLOR=#0000ff] If [/COLOR]shp.Name = "TextBox 1" [COLOR=#0000ff]Then[/COLOR]
         [COLOR=#0000ff]   If[/COLOR] InStr(shp.TextFrame.Characters.Text, "FindValue") Then[COLOR=#008000] 'Test to see if value is in Textbox[/COLOR]
                shp.TextFrame.Characters.Text = Replace(shp.TextFrame.Characters.Text, "FindValue", "ReplaceValue")[COLOR=#008000] 'Replace it[/COLOR]
[COLOR=#0000ff]            End If[/COLOR]
[COLOR=#0000ff]        End If[/COLOR]

 

[vizgraphics]

Thank you for the reply. I was able to get a little farther but still can't figure out how to get the script to look in jobMapping.xlsx column Q for find values, then replace then column R values. I can put a number in the string as shown in the code below and it works. How would I look to column Q and replace with R from external jobMapping.xlsx?

Sub ConvertJobNumbers()
    Dim NameListWB As Workbook, thisWb As Workbook
    Dim NameListWS As Worksheet, thisWs As Worksheet
    Dim i As Long, lRow As Long
    Dim shp As Object
    


    'This is the workbook from where your code is running
    Set thisWb = ThisWorkbook
    'This is the Sheet we are looking at to replace text in
    Set thisWs = thisWb.Sheets("Sheet1")


    'Open external file to find and replace from
    Set NameListWB = Workbooks.Open("jobMapping.xlsx")
    Set NameListWS = NameListWB.Worksheets("Sheet1")


    With NameListWS
        'Look for textboxes and other shapes
        For Each shp In thisWs.Shapes
        'Do the replace
           ' If shp.Name = "TextBox 1" Then
             'shp.TextFrame.Characters.Text.Replace What:=.Range("Q" & i).Value, _
              'Replacement:=.Range("R" & i).Value, _
              'SearchOrder:=xlByColumns, _
              'MatchCase:=False
        'End If
        
        If shp.Name = "TextBox 1" Then
            If InStr(shp.TextFrame.Characters.Text, "0100-00-000") Then 'Test to see if value is in Textbox
                shp.TextFrame.Characters.Text = Replace(shp.TextFrame.Characters.Text, "0100-00-000", "ReplaceValue") 'Replace it
            End If
        End If
       Next shp
    End With
End Sub

 

[mrmmickle1]

You will need to loop through your worksheet values....

Here is an example:

[COLOR=#0000ff]Sub[/COLOR] Test()


[COLOR=#0000ff]    Dim[/COLOR] lRow[COLOR=#0000ff] As Long[/COLOR]
    [COLOR=#0000ff]Dim[/COLOR] i   [COLOR=#0000ff] As Long[/COLOR]
    
    lRow = Cells(Rows.Count, "Q").End(xlUp).Row [COLOR=#008000]'Define last row in Column Q[/COLOR]
        
[COLOR=#0000ff]    For [/COLOR]i = 2 [COLOR=#0000ff]To [/COLOR][COLOR=#000000]lRow[/COLOR][COLOR=#0000ff][/COLOR] [COLOR=#008000]'Starts on Row 2....goes to last Row[/COLOR]
       [COLOR=#0000ff] If[/COLOR] shp.Name = "TextBox 1" [COLOR=#0000ff]Then[/COLOR]
         [COLOR=#0000ff]    If [/COLOR]InStr(shp.TextFrame.Characters.Text, Cells(i, "Q")) [COLOR=#0000ff]Then [/COLOR][COLOR=#008000]'Test to see if value is in Textbox[/COLOR]
                 shp.TextFrame.Characters.Text = Replace(shp.TextFrame.Characters.Text, Cells(i, "Q"), Cells(i, "R"))[COLOR=#008000] 'Replace it[/COLOR]
[COLOR=#0000ff]             End If[/COLOR]
[COLOR=#0000ff]         End If[/COLOR]
[COLOR=#0000ff]    Next[/COLOR] i
[COLOR=#0000ff]
[/COLOR]
[COLOR=#0000ff]End Sub[/COLOR]

 

[vizgraphics]

Worked like a charm! Thank for all your help!

 

[mrmmickle1]

Your welcome. Glad you got your issue sorted.

 

[vizgraphics]

Ok I spoke to soon. When I ran a simple test it works. When I paste my huge chunk of text in the text box to test I get a "Run-time error '1004': Unable to get the Text property of the character data." It's almost like there's a character limit issue or something. If I put a few lines in it works but lots of text trips it up. Thoughts?

Sub ConvertJobNumbers()
    Dim NameListWB As Workbook, thisWb As Workbook
    Dim NameListWS As Worksheet, thisWs As Worksheet
    Dim i As Long, lRow As Long
    Dim shp As Object
    


    'This is the workbook from where your code is running
    Set thisWb = ThisWorkbook
    'This is the Sheet we are looking at to replace text in
    Set thisWs = thisWb.Sheets("Sheet1")


    'Open external file to find and replace from
    Set NameListWB = Workbooks.Open("jobMapping.xlsx")
    Set NameListWS = NameListWB.Worksheets("Sheet1")


    With NameListWS
        'Look for textboxes and other shapes
        For Each shp In thisWs.Shapes
        lRow = Cells(Rows.Count, "Q").End(xlUp).Row 'Define last row in Column Q
        For i = 1 To lRow 'Starts on Row 1....goes to last Row
        If shp.Name = "TextBox 1" Then
             If InStr(shp.TextFrame.Characters.Text, Cells(i, "Q")) Then 'Test to see if value is in Textbox
                 shp.TextFrame.Characters.Text = Replace(shp.TextFrame.Characters.Text, Cells(i, "Q"), Cells(i, "R")) 'Replace it
             End If
         End If
    Next i
       Next shp
    End With
End Sub

 

[mrmmickle1]

The native Find function (i.e. Ctrl + F) in Excel has an 8192 character limit.

There is an individual cell character limit of 32,767 (Excel will only display the first 1024 characters in a cell...)

How much data do you have in your textbox? You can use

mytextboxlength =  LEN([COLOR=#333333]shp.TextFrame.Characters.Text) [/COLOR]

to find out....

 

[vizgraphics]

I have much more that 32000 characters. I think I need to explore another route. Maybe I'll look to read from txt file vs in a text Box. Thanks again for all your help!

 

[mrmmickle1]

Yes, sounds like you may have to look at other options..... post another thread if you have questions regarding a different route.