Find and Replace text within string

Hi,

I'm new to this forum and only starting out with VBA in excel and I am wondering if anyone here can help me.

I am looking for a bit of code to search an external link e.g. U:/Workbooks/[Example123456.xls]Sheet1'!$E$10
and replace the 123456 only with a cell ref. for example:

if
A2 = 654321

then
link=U:/Workbooks/[Example654321.xls]Sheet1'!$E$10

if
A2 = 555555

then
link=U:/Workbooks/[Example555555.xls]Sheet1'!$E$10

the numbers are always 6 chars long and I need it to do this across serveral sheets

A1=Sheet1 A1:O40
A2=Sheet2 A1:O40

and so on.
This is what I have currently

Sub ReplaceFC()
    Dim Rng As Range
    Dim c As Range
    Dim Length As Integer
    Dim LeftSide As Integer
    Dim RightSide As Integer
    With Sheets(3).Range("A:O")
        Set Rng = Range("A1:O" & Range("O65536").End(xlUp).Row)
        For Each c In Rng
            LeftSide = InStr(c, "[")
            RightSide = InStr(LeftSide + 13, c, "]")
            Length = RightSide - LeftSide
            If Length = 13 Then
                c.Characters(Start:=LeftSide, Length:=Length).Replace = Sheets(2).Range("h2")
            End If
        Next c
    End With
End Sub

Many thanks in advance

Graham

Hello Soulbringer,

Welcome to the Fourm!

I have a few questions about your post.

1. Is the link part of the cell's formula?
2. Are all worksheets to be searched?
3. Are the file names just 6 digits followed by the extension like 123456.xls?

Hello Soulbringer,

Each project in the workbook is a separate worksheet and the list that reflects which sheets to examine is on the "Data" worksheet. Have I got that right?

Hello Soulbringer,

Sorry for the delay. The attached workbook has been modified from your original post. A dynamic named range "Project_Number" now refers to the project numbers from A2 down to the last project number in column "A". A button has been added to the "Data" sheet to run the macro.

' Thread:  http://www.excelforum.com/excel-programming/839394-find-and-replace-text-within-string.html
' Poster:  Soulbringer
' Written: June 19, 2012
' Author:  Leith Ross (www.excelforum.com)

Sub UpdateProjectLinks()

    Dim C As Long
    Dim Formula As Variant
    Dim Formulas As Variant
    Dim Project As Range
    Dim R As Long
    Dim RegExp As Object
    Dim Wks As Worksheet
        
        Application.DisplayAlerts = False
        
        Set RegExp = CreateObject("VBScript.RegExp")
        RegExp.IgnoreCase = True
        RegExp.Pattern = "\[(\w+\.xlsx)\]"
        
        For Each Project In Range("Project_Number")
            On Error Resume Next
                Set Wks = Worksheets(Project.Text)
            On Error GoTo 0
            If Err = 9 Or Wks Is Nothing Then GoTo SkipUpdate
            Formulas = Wks.UsedRange.Formula
                For C = 1 To UBound(Formulas, 2)
                    For R = 1 To UBound(Formulas, 1)
                        Formula = Formulas(R, C)
                        If Left(Formula, 1) = "=" Then
                            If RegExp.Test(Formula) = True Then
                                Formulas(R, C) = RegExp.Replace(Formula, "[" & Project.Text & ".xlsx]")
                            End If
                        End If
                    Next R
                Next C
            Wks.UsedRange.Formula = Formulas
SkipUpdate:
            Set Wks = Nothing
        Next Project
        
        Application.DisplayAlerts = True
        
End Sub

Leith,

Thank you for that code.

I have altered it slightly to incorperated it into the actual workbook I am using.
I can not get all the work books to update though.

I cannot however upload the file from work as we use sensitive material.

I shall try my best to explain what I have done.

Here is the code.

Sub UpdateProjectLinks()

    Dim C As Long
    Dim Formula As Variant
    Dim Formulas As Variant
    Dim Project As Range
    Dim R As Long
    Dim RegExp As Object
    Dim Wks As Worksheet
        
        Application.DisplayAlerts = False
        
        Set RegExp = CreateObject("VBScript.RegExp")
        RegExp.IgnoreCase = True
        RegExp.Pattern = "\[(\w+\.xls)\]"
        
        For Each Project In Sheets("Data").Range("H3:H40")
            On Error Resume Next
                Set wb = ThisWorkbook
                Set wsData = wb.Worksheets("Data")
                Set Wks = wb.Worksheets(wsData.Range("D3:D40").Value)
            On Error GoTo 0
            If Err = 9 Or Wks Is Nothing Then GoTo SkipUpdate
            Formulas = Wks.UsedRange.Formula
                For C = 1 To UBound(Formulas, 2)
                    For R = 1 To UBound(Formulas, 1)
                        Formula = Formulas(R, C)
                        If Left(Formula, 1) = "=" Then
                            If RegExp.Test(Formula) = True Then
                                Formulas(R, C) = RegExp.Replace(Formula, "[" & Project.Text & ".xls]")
                            End If
                        End If
                    Next R
                Next C
            Wks.UsedRange.Formula = Formulas
SkipUpdate:
            Set Wks = Nothing
        Next Project
        
        Application.DisplayAlerts = True
        
        
        
End Sub

In Column H is the data that I would like to place within the string
In column D is the worksheet name to be looked up

The macro doesn't need to change the worksheet names as I have another macro working indepentantly

Many Thanks

Graham

Hello Graham,

What you want to do now is a significant departure from your original request. Can you show me the contents of columns "D" and "H"?