How can I replace only the date in a filename with VBA?

Question

I have the following formula:

=IF(IFERROR(MATCH($C3,'\\share\done\[dones 05.10.2016.xls]done'!$A$2:$A$49,0),0),VLOOKUP($C3,'\\share\done\[dones 05.10.2016.xls]done'!$A$2:$B$49,2,FALSE),0)

In A1 I have another date: 10.10.2016

How can I replace only the date that is in the file name from the formula?

Until now, I've been using this:

Sub modify()
    Dim a As Range
    Set a = Range("a1")
    [e3:e4].Replace "dones 05.10.2016.xls", ("dones " & a & ".xls"), xlPart
End Sub

The problem that in A2 I have another date and F3:F4 must have the date from A2, and so on until A300. How can I replace only the date of the file name in the formula?

The names of the files are standard: dones dd.mm.yyyy.xls

Answer 1

My understanding of the requirements is this:

1. There is a List of Dates in Column A starting at Row 1
2. A formula needs to be entered in rows 3:4 starting in Column E and moving one column to the right for each value in the List of Dates, i.e. Formula in column E has date from row 1, column F has date from row 2, …

3. This is the formula, in which the date 05.10.2016 in the filename '\\share\done\[dones 05.10.2016.xls]done should be update with corresponding value from the List of Dates as per point 2.

   =IF( IFERROR(MATCH($C3,'\\share\done\[dones 05.10.2016.xls]done'!$A$2:$A$49,0),0), VLOOKUP($C3,'\\share\done\[dones 05.10.2016.xls]done'!$A$2:$B$49,2,FALSE),0)

This solution assumes the dates in column A are already formated as required by the filename link.

This solution uses a variable to hold the Link Formula and another variable to update the Link Formula with each Value in the List of Dates. Also to simplify the update\replacement of the date let’s change the original date in the formula for 05.10.2016 for an unique key such as #DATE

Dim sFmlLink As String, sFml As String
sFmlLink = "=IF(" & Chr(10) & _
    "IFERROR(MATCH($C3,'\\share\done\[dones #DATE.xls]done'!$A$2:$A$49,0),0)," & Chr(10) & _
    "VLOOKUP($C3,'\\share\done\[dones #DATE.xls]done'!$A$2:$A$49,2,FALSE),0)"

Then we set a Range with the List of Dates and loop trough it to update and enter the formula as per point 2.

Sub FormulaLink()
Dim sFmlLink As String, sFml As String
sFmlLink = "=IF(" & Chr(10) & _
    "IFERROR(MATCH($C3,'\\share\done\[dones #DATE.xls]done'!$A$2:$A$49,0),0)," & Chr(10) & _
    "VLOOKUP($C3,'\\share\done\[dones #DATE.xls]done'!$A$2:$A$49,2,FALSE),0)"
Dim rDates As Range, lRow As Long, iCol As Integer

    Rem Set Start Column
    iCol = 5
    With ThisWorkbook.Sheets("DATA")
        Rem Set Dates List Range
        Set rDates = Range(.Cells(1), .Cells(Rows.Count, 1).End(xlUp))
        Rem Enter Link Formula in Rows 3:4, starting at Column 5
        Rem and moving one column to the right for each Date in Column A
        For lRow = 1 To rDates.Rows.Count
            Rem Refresh Link Formula with Date from Column A
            sFml = Replace(sFmlLink, "#DATE", rDates.Cells(lRow).Value)
            Rem Enter Formula in Column iCol Rows 3:4
            .Cells(3, iCol).Resize(2).Formula = sFml
            Rem Move One Column to the right
            iCol = 1 + iCol
    Next: End With
    End Sub

Answer 2

Sub modify()
    Dim c As Range, r As Range
    Set c = [a1]
    Set r = [e3:e4]
    Application.DisplayAlerts = False ' optional to hide dialogs

    While c > ""
        Debug.Print c.Address(0, 0), r.Address(0, 0) ' optional to check the address

        r.Replace "[dones ??.??.????.xls]", "[dones " & c & ".xls]", xlPart
        Set c = c.Offset(1, 0) ' A1 to A2
        Set r = r.Offset(0, 1) ' E3:E4 to F3:F4
    Wend
    Application.DisplayAlerts = True
End Sub

---

Replace with wildcards:

[e3:e4].Replace "[dones ??.??.????.xls]", "[dones " & [a1] & ".xls]", xlPart

? matches any single character and * can be used to match 0 or more characters:

[e3:e4].Replace "[*.xls*]", "[dones " & [a1] & ".xls]", xlPart

https://www.ablebits.com/office-addins-blog/2015/09/29/using-excel-find-replace/#find-replace-wildcards

Answer 3

Instead of hard-coding "dones 05.10.2016.xls", you'll have to build that string from the cell values. Also, you'll need some looping logic to track which row you're reading from and which column you're writing to.

Assuming a date read in row 1 goes in column 5, a date read in row 2 goes in column 6, and so on, something like this should be good enough:

Dim targetColumn As Long
Dim sourceRow As Long

With ActiveSheet
    For sourceRow = 1 To WhateverTheLastRowIs
        targetColumn = 4 + sourceRow 'column 5 / "E" for sourceRow 1

        Dim sourceDateValue As Variant
        sourceDateValue = .Cells(sourceRow, 1).Value
        Debug.Assert VarType(sourceDateValue) = vbDate

        Dim formattedSourceDate As String
        formattedSourceDate = Format(sourceDateValue.Value, "MM.DD.YYYY")

        'replace string in rows 3 & 4 of targetColumn:
        .Range(.Cells(3, targetColumn), .Cells(4, targetColumn) _
            .Replace "[*.xls]", "[dones " & formattedSourceDate & ".xls]", xlPart
    Next
End With

Answer 4

You will need to work with the string functions InStr and Mid here. Maybe this can help you:

Dim str As String
Dim intPos1 As Integer
Dim intPos2 As Integer
Dim intLastPos As Integer

'Formula as string
   str = "\\share\done\[dones 05-10-2016.xls]done'!$A$2:$A$49,0),0),VLOOKUP($C3,'\\share\done\[dones 05-10-2016.xls]done"

'Get the start and the End Position of the First Excel File
  intPos1 = InStr(1, str, "[dones") - 1
  intPos2 = InStr(1, str, ".xls") + 5

'Save the Last Postion for the second Replacement
  intLastPos = intPos2


'Replace old  File with [dones 01-10-1911.xls]

  str = Mid(str, 1, intPos1) & "[dones 01-10-1911.xls]" & Mid(str, intPos2, Len(str))

'Get the start and the End Position of the second Excel File
  intPos1 = InStr(intLastPos, str, "[dones")
  intPos2 = InStr(intLastPos, str, ".xls")


'Replace the second File with [dones 01-10-1911.xls]
  str = Mid(str, 1, intPos1) & "[dones 01-10-1911.xls]" & Mid(str, intPos2, Len(str))

After that you can read back the formula.