How can I replace only the date in a filename with VBA? - 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

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 2

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 3

My understanding of the requirements is this:
There is a List of Dates in Column A starting at Row 1
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, …
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 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.