Update formula based on cell selection

Hi All,

firstly, apologies if this has already been asked but each time I try to search, I get a web error

I have a data validation in cell A2 which contains a list of people initials. In cells A4:IM12 I have a formula linking to an existing workbook on my network. Each member contained in A2 has their own workbook called [Initials] Task Planner.xls

What I am trying to do is each time a name is selected in A2 is for the formulae in A4:IM12 to automatically update so that the cells point to the correct workbook.

Any suggestions on how to do this please as it has me completely stumped.

Cheers in advance!

Mav

The easiest way would probably be to effectively automate the Edit Links function. Do you have any other links to external files in the workbook?

Then you'll need to store the last Initials value, either in a cell or in a named range. You can then use a Worksheet_Change event to compare the new value of the cell with the last set of initials chosen, and update the links if required. Something like this:

Const cstrWORKBOOK_NAME As String = " Task Planner.xls"
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim arrLinks, i As Long
    Dim strOldLink As String, strNewLink As String
    ' check if A2 changed and if it's not blank
    If Not Intersect(Target, Range("A2")) Is Nothing And Len(Range("A2").Value) > 0 Then
        ' get new initials
        strNewLink = Range("A2").Value
        ' get last initials (need to strip off leading = sign)
        strOldLink = [LastInitials]
        If StrComp(strOldLink, strNewLink, vbTextCompare) = 0 Then
            ' no change, do nothing
        Else
            ActiveWorkbook.Names("LastInitials").RefersTo = strNewLink
                
            ' find the link we want to alter
            arrLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
            If Not IsEmpty(arrLinks) Then
                For i = 1 To UBound(arrLinks)
                    If InStr(1, arrLinks(i), strOldLink & cstrWORKBOOK_NAME, vbTextCompare) > 0 Then
                        On Error Resume Next
                        ' turn events off so we don't get stuck in a loop when the formulas get changed
                        Application.EnableEvents = False
                        ActiveWorkbook.ChangeLink arrLinks(i), Replace(arrLinks(i), strOldLink & cstrWORKBOOK_NAME, strNewLink & cstrWORKBOOK_NAME)
                        ' turn events back on
                        Application.EnableEvents = True

                        Exit For
                    End If
                Next i
            End If
        End If
    End If
End Sub

Change this line:

        strNewLink = Range("A2").Value

to use A3 instead.

I forgot to mention that you need to define a name called LastInitials and assign it the value of the initials currently in use by your formula.