Help automating updating columns (find and replace) with macros.

[Stacker]

I routinely get files and people here have helped me with automating one component. However I wanna create a macros that allows m to automate the updating of certain worksheets. I am given an excel file with three tabs.

In the first tab i get a lot of hospital data and one of my tasks is to to copy the last column say MG and paste it into the MH. All of the cells in the column follow a certain formula. The top being like so:

=SUM('\\sancifs\Public_Health\Shared\PH Intelligence\Data\PHI_Data_Intelligence_System\1-PHI_DI_SYS_RAW-IMPORT\COVID-19_data\Hospital_reporting\Both Trusts\[270821 HRI.xlsx]Daily sitrep'!$F$8:$F$11)

I have to paste this column into the next and from there ctrl and f and find and replace. So I would find and replace 270821 with 280821 solely in that column.

Is there a way to copy and paste the previous column and then find and replace by incrememnts of 1 day using a macro.

The second and third stuff are fairly quick so I am not bothered

 

[GWteB]

Is there a way to copy and paste the previous column and then find and replace by incrememnts of 1 day using a macro.

See if this works for you ...

Public Sub Stacker()

    Dim sOld As String, sNew As String, LinkState As XlUpdateLinks
    Dim oWs As Worksheet, Rng As Range, dDate As Date
    Dim FSO As Object, FullName As Variant

    Const SOURCECOLUMN As String = "MG"          ' <<<<< change column to suit
    
    Set oWs = ThisWorkbook.Worksheets("Sheet1")  ' <<<<< change sheet name to suit

    Application.EnableEvents = False
    Application.DisplayAlerts = False
    LinkState = oWs.Parent.UpdateLinks
    oWs.Parent.UpdateLinks = xlUpdateLinksNever

    With oWs
        Set Rng = .Range(SOURCECOLUMN & "1:" & SOURCECOLUMN & .Cells(.Rows.Count, SOURCECOLUMN).End(xlUp).Row).Offset(0, 1)
    End With
    Rng.Offset(0, -1).Copy Rng

    sOld = Rng(3).Formula   ' <<<< perhaps two header rows, so get formula from 3rd row
    
    sOld = Mid$(sOld, InStrRev(sOld, "\[") + 2, 6)
    sNew = Mid$(sOld, 1, 2) & "-" & Mid$(sOld, 3, 2) & "-" & Mid$(sOld, 5, 2)

    If IsDate(sNew) Then
        dDate = DateValue(sNew) + 1
        sNew = IIf(Len(Day(dDate)) = 2, Day(dDate), "0" & Day(dDate)) & _
               IIf(Len(Month(dDate)) = 2, Month(dDate), "0" & Month(dDate)) & _
               Right(Year(dDate), 2)
        Rng.Replace "\[" & sOld, "\[" & sNew, xlPart, , False
        
        Set FSO = CreateObject("Scripting.FileSystemObject")
        With ThisWorkbook
             For Each FullName In .LinkSources
                If FSO.FileExists(FullName) Then
                    .UpdateLink Name:=FullName, Type:=xlExcelLinks
                End If
             Next FullName
        End With
    Else
        MsgBox "Apparently this part of the file name (" & sOld & ") is not a valid date.", vbExclamation
    End If

    Application.DisplayAlerts = True
    oWs.Parent.UpdateLinks = LinkState
    Application.EnableEvents = True
End Sub

 

[Stacker]

sOld = Rng(3).Formula ' <<<< perhaps two header rows, so get formula from 3rd row

MG1 is a blue filled cell whilst MG2 is a date 27/3/2021 whilst mg3 is where the cells with formulas begin.

I tried running the code and it said compile error expected end sub and fails the moment i start pressing F8

 

[GWteB]

MG1 is a blue filled cell whilst MG2 is a date 27/3/2021 whilst mg3 is where the cells with formulas begin.

Was just a wild guess, now you've confirmed it, it should work for that matter.

I tried running the code and it said compile error expected end sub and fails the moment i start pressing F8

Looks like you didn't copy ALL the code. On the top right corner of each of the code boxes on this forum there's a copy icon, see attached image.
Clicking on that icon copies the code into the clipboard in its entirety, wich will be confirmed by a temporary banner on top of your screen.

 

[Stacker]

That was the problem. As the macro goes through all the files it takes so long and slows down my laptop like crazy. Like holy ****.

 

[GWteB]

As the macro goes through all the files it takes so long and slows down my laptop like crazy

Is the above the previous situation or the current situation?
If it's the current, you could try to add the following lines of code:

Near the top of the procedure:

Application.Calculation = xlCalculationManual

Near the bottom of the procedure:

Application.Calculation = xlCalculationAutomatic

 

[Stacker]

It's still slow. The macro only added one column and it took like 30s to stop running the macro. Is there a way to change the macro so it adds files until there are no more files. 270821 HRI.xlsx is an example of a file name,

 

[GWteB]

Your query as of your post #1 was:
- copy column MG to column MH;
- adjust the formulas within column MH by replacing a date string with a date string that represents the next day.
Thats what my code does.
FYI, it's not copying the entire column, just the part that contains any data. Although I was pretty sure that the performance penalty was caused by the external links, I examined this and got it confirmed. The moment a formula with a link to another workbook is entered in a cell, it is immediately evaluated, regardless whether update links and calculation are disabled or not.

Is there a way to change the macro so it adds files until there are no more files

This part I do not understand.

Anyway, I've amended my previous code in a way that it might run slightly faster. Below three outcomes of 50K+ rows on a 10 years old machine:

1) from text to text:

2) from text to formula:

3) from formula to formula:

You should bear in mind that no data was actually retrieved during these tests!

Public Sub Stacker_r2()

    Dim sOld As String, sNew As String, LinkState As XlUpdateLinks
    Dim oWs As Worksheet, Rng As Range, dDate As Date
    Dim Formulas As Variant, Start As Long, i As Long
    Dim FSO As Object, FullName As Variant

    Const SOURCECOLUMN As String = "MG"          ' <<<<< change column to suit
    
    
    Dim TimerStart As Double, TimerOne As Double, TimerTwo As Double, TimerThree As Double
    TimerStart = VBA.Timer

    Set oWs = ThisWorkbook.Worksheets("Sheet1")  ' <<<<< change sheet name to suit

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

    LinkState = oWs.Parent.UpdateLinks
    oWs.Parent.UpdateLinks = xlUpdateLinksNever

    With oWs
        Set Rng = .Range(SOURCECOLUMN & "1:" & SOURCECOLUMN & .Cells(.Rows.Count, SOURCECOLUMN).End(xlUp).Row)
    End With
    Formulas = Rng.Formula

    For i = LBound(Formulas, 1) To UBound(Formulas, 1)
        Start = InStrRev(Formulas(i, 1), "\[")
        sOld = Mid$(Formulas(i, 1), Start + 2, 6)
        If Len(sOld) = 6 Then
            sNew = Mid$(sOld, 1, 2) & "-" & Mid$(sOld, 3, 2) & "-" & Mid$(sOld, 5, 2)
            If IsDate(sNew) Then
                dDate = DateValue(sNew) + 1
                sNew = IIf(Len(Day(dDate)) = 2, Day(dDate), "0" & Day(dDate)) & _
                       IIf(Len(Month(dDate)) = 2, Month(dDate), "0" & Month(dDate)) & _
                       Right(Year(dDate), 2)
                Formulas(i, 1) = Left(Formulas(i, 1), Start - 1) & VBA.Replace(Formulas(i, 1), "\[" & sOld, "\[" & sNew, Start, 1)
            End If
        End If
    Next i

    TimerOne = VBA.Timer - TimerStart

    Rng.Offset(0, 1).Formula = Formulas

    TimerTwo = VBA.Timer - TimerStart - TimerOne

    Set FSO = CreateObject("Scripting.FileSystemObject")
    With ThisWorkbook
        If Not IsEmpty(.LinkSources) Then
            For Each FullName In .LinkSources
                If FSO.FileExists(FullName) Then
                    .UpdateLink Name:=FullName, Type:=xlExcelLinks
                End If
            Next FullName
        End If
    End With

    TimerThree = VBA.Timer - TimerStart - TimerOne - TimerTwo

    Application.DisplayAlerts = True
    oWs.Parent.UpdateLinks = LinkState
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox UBound(Formulas, 1) & " formulas processed, this took " & TimerOne & " seconds." & vbNewLine & _
           "Putting these formulas back on the worksheet took " & TimerTwo & "  seconds." & vbNewLine & _
           "Updating Linksources took " & TimerThree & "  seconds." & vbNewLine & _
           "Total duration: " & VBA.Timer - TimerStart & " seconds."
           
End Sub

 

[Stacker]

It just seems to take a long time to load. I get a series of files daily, these files need to be renamed in a particular format. The formula refers to these files and pulls data from inside these files. I got this error

 

[GWteB]

The message you're getting is not an error, it's just information provided by the code I posted in #8.

This information confirms my suspicion: the performance problem that now occurs when copying data and modifying formulas is NOT caused by my code, but by the way the data is organized in all involved workbooks and mainly the way data is collected, through multiple links to multiple workbooks (which are also on a network share instead of in a folder of the local system, which can also cause a certain delay).

It may be wise to move away from the current concept and collect cumulative data in a different way.