Replace External Links with Values inside Formulas

Hello,

I have a workbook with multiple sheets. Many of the cells have formulas like "=I3*[Other Book]Sheet1!H5+I4*[Dif Book]!Sheet2!D4+J3". Assuming that [Other Book]Sheet1!H5 = 3 and [Dif Book]!Sheet2!D4 = 2, I would like to make a macro that changes this to "=I3*3+I4*2+J3". It can be manually done by highlighting the external parts of the formula one by one and hitting F9, then saving the formula, but this would take forever.

Maybe:

Sub k64()
Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet
Dim rcell As Range
Set ws = ActiveSheet
Set ws1 = Workbooks("Other Book.xlsx").Sheets("Sheet1")
Set ws2 = Workbooks("Dif Book.xlsx").Sheets("Sheet2")
If ws1.Cells(5, "H") = 3 And ws2.Cells(4, "D") = 2 Then
    ws.Cells.Replace "'[Other Book.xls]Sheet1'!$H$5", 3, xlPart
    ws.Cells.Replace "'[Dif Book.xls]Sheet2'!$D$4", 2, xlPart
End If
End Sub

Thanks JOHN H. DAVIS. That gives me a great idea. I'm going to try modifying your code to open all the workbooks listed in the LinkSources and then find and replace their formulas with the appropriate values. It might be tricky because I have to match anything of the form [WB Name]SheetName!LETTER#, but I'll see how it goes.

I'm currently stuck on how to evaluate part of a regex expression. I want to use the pattern matches to reference an external workbook and pull the value. Do you know how to do that. Here is my current code, which is a mess since I'm in the middle of writing it:

Sub remove_ext_refs()
Dim wb As Workbook
Set wb = ActiveWorkbook
wb.SaveAs wb.Path & "\FL Exhibit B V3.xlsx", xlOpenXMLWorkbook
For Each link In wb.LinkSources
    On Error Resume Next
        Workbooks.Open link
    On Error GoTo 0
    Name = Mid(link, InStrRev(link, "\") + 1, 100)
    With CreateObject("VBScript.RegExp")
        .Global = True
        Name = "Premiums, Policy Counts, Claims Amounts.xlsx"
        .Pattern = "('?\[" & Name & "\]([^!']+)'?!([0-9A-Z:$]+))"
        test = "='[Premiums, Policy Counts, Claims Amounts.xlsx]Earn Prem'!$B12"
        Debug.Print Evaluate(test)
        test2 = .Evaluate("$1")
        Debug.Print .Replace(test, "$1")
        Debug.Print .Replace(test, Workbooks(Name).Sheets("$1").Range("$2").Value)
        Range("error").Value = True
        For Each sht In wb.Sheets
            sht.UsedRange.Formula = .Replace(sht.UsedRange.Formula, Workbooks(Name).Sheets("$2").Range("$3").Value)
        Next sht
    End With
Next link
End Sub

I finally figured it out. My code is below, for posterity. It goes through and replaces any single-cell external reference in a formula with the appropriate value. It then breaks the connection, so that any cell containing an external range gets converted to a value.

Sub remove_ext_refs()
'Application.DisplayAlerts = False
'Application.AskToUpdateLinks = False
Dim wb As Workbook
Set wb = ActiveWorkbook
wb.SaveAs wb.Path & "\FL Exhibit B V3.xlsx", xlOpenXMLWorkbook
Set reg = CreateObject("VBScript.RegExp")
For Each link In wb.LinkSources
    On Error Resume Next
        Workbooks.Open link, False
    On Error GoTo 0
    Name = Mid(link, InStrRev(link, "\") + 1, 100)
    With reg
        .Global = True
        .Pattern = "('?\[" & Name & "\]([^!']+)'?!([0-9A-Z:$]+))"
        For Each sht In wb.Sheets
            For Each cell In sht.UsedRange
                For Each ref In .Execute(cell.Formula)
                    If InStr(ref, ":") = 0 Then cell.Formula = Replace(cell.Formula, ref, CStr(Evaluate("" & ref & "")))
                Next ref
            Next cell
        Next sht
    End With
    wb.BreakLink link, xlLinkTypeExcelLinks
    Workbooks(Name).Close False
Next link
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
End Sub