Hi. I have a macro which does the job I ask of it but I'd be grateful if anyone here could advise on how to speed it up. It's basically a find and replace on around 370,000 cells (1600 rows by 230 columns). I ran it on a subset and it took a bit under half an hour to do 46 columns. For all I know, this is as fast as it will go and it's not really a major problem, I can just go and make a cup of tea, or two, but I'd be interested to know if anything I've done is particularly cumbersome or contributing to its efficiency. (I picked up a useful tip on this site on turning on manual calculation.)
To sum up what I'm doing, each of the 1600 cells in each column is linked to the value of a cell in another file. Each column is linked to a different file but the cell references are the same so the macro just copies the 'link' formulae across all 230 columns and then replaces the file name in each. It may not be an ideal starting point but that's what I've inherited.
Sub ReplaceLAnumbers() Dim i As Integer Dim LAno, startLAno As String Dim lastcol As Long Dim xlCalc As XlCalculation ' Turns on manual calculation to speed things up. xlCalc = Application.Calculation Application.Calculation = xlCalculationManual On Error GoTo CalcBack ' This macro will run through all LAs on active sheet and update links appropriately. ' Make sure that LA numbers of respondents are pasted in first row and that the ' link formulae are correct for the first LA (in third column). Application.ScreenUpdating = False ' Identifies first LA number to be replaced in other columns. startLAno = ActiveSheet.Cells(1, 3).Text ' If startLAno <100 then insert leading zero(s). If Len(startLAno) = 1 Then startLAno = "00" & startLAno ElseIf Len(LAno) = 2 Then startLAno = "0" & startLAno End If ' Finds last column (LA) with data lastcol = 3 Do Until ActiveSheet.Cells(1, lastcol).Value = "" lastcol = lastcol + 1 Loop lastcol = lastcol - 1 ' Copies formula from first LA to all others Range(Cells(6, 3), Cells(1604, 3)).Copy Destination:= _ Range(Cells(6, 4), Cells(1604, lastcol)) ' Main loop for replacing each LA number For i = 4 To lastcol LAno = ActiveSheet.Cells(1, i).Text ' If LAno <100 then insert leading zero(s). If Len(LAno) = 1 Then LAno = "00" & LAno ElseIf Len(LAno) = 2 Then LAno = "0" & LAno End If ' Amend range as necessary. Range(Cells(6, i), Cells(1604, i)).Replace What:=startLAno, Replacement:=LAno, _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False Next i Application.ScreenUpdating = True Application.Calculation = xlCalc CalcBack: Application.Calculation = xlCalc End Sub