Faster way to link ranges to external workbook?

[thechazm]

Hello All,

I have been trying to make the performance of my VBA code go faster as I am trying to complete a simple operation in a short period of time. I am trying to link one worksheet in a workbook to another worksheet in another workbook with only the data that I care about. So far everything is extreamely fast except for when I apply the forumla to the local worksheets range. It pauses and gets slower after each row is filled in with the linking formula. Is there anyway to prevent excell from doing any linking until I have finished filling in all my cells with the proper formulas or just some way to speed this up?

Below is my current code that works 100% but like I said it's just to slow when applying the formula to the range. The line in red below is the one that is slow and keeps slowing down after each call very slightly but after linking 2500 cell ranges is pretty slow at that point.

Function SelectedProjectsMod()
FastVBA
On Error GoTo ErrHandler
Dim xlsRemoteApp As Excel.Application, xlsRemoteWB As Excel.Workbook, xlsRemoteSheet As Excel.Worksheet, xlsApp As Excel.Application, xlsWB As Excel.Workbook, xlsSheet As Excel.Worksheet
Dim xlsRef As Excel.Worksheet, xlsModify As Excel.Worksheet, dDateRan As Boolean
Dim LastColumn As String, LastRow As Long
' New Search Variables
Dim fndShop As Range, countShop As Long, NNLine As Long, NULine As Long
Set xlsApp = Application
Set xlsWB = xlsApp.Workbooks(1)
Set xlsSheet = xlsWB.Worksheets("Select Projects")
Set xlsRef = xlsWB.Worksheets("Ref")
NNLine = 2
For i = 2 To xlsRef.Cells(xlsSheet.Rows.Count, "A").End(xlUp).Row
    Set xlsRemoteApp = New Excel.Application
    Set xlsRemoteWB = xlsRemoteApp.Workbooks.Open(xlsRef.Cells(i, 2))
    Set xlsRemoteSheet = xlsRemoteWB.Worksheets(1)
    
    ' Sets whether the data is nuclear or not.
    If InStr(1, xlsRef.Cells(i, 3), "Non") > 0 And xlsRef.Cells(i, 1) = 700 Then
        Set xlsModify = xlsWB.Worksheets("NN")
        LastColumn = ColLett(xlsRemoteSheet.Range("A1" & ":BB1").End(xlToRight).Column + 1)
        For Each s In ShopArray ' Tells the search which shop I want to look at and find.
            Set fndShop = xlsRemoteSheet.Range("A:A")
            countShop = xlsRemoteApp.WorksheetFunction.CountIf(fndShop, s)
        
            For ii = 1 To countShop Step 1
                If ii = 1 Then
                    Set fndShop = xlsRemoteSheet.Range("A:A").Find(s)
                Else
                    Set fndShop = xlsRemoteSheet.Range("A:A").Find(s, fndShop, , , , xlNext)
                End If
                Debug.Print "Shop: " & s & " Found at: " & fndShop.Address
                
                [COLOR=#ff0000][B]With xlsModify.Range("B" & NNLine & ":" & LastColumn & NNLine)
                    .Formula = LinkCell(xlsRemoteApp.CommandBars("Web").Controls("Address:").Text, xlsRemoteSheet.Name, "A" & fndShop.Row)
                    NNLine = NNLine + 1
                End With
[/B][/COLOR]            Next ii
        
        Next s
                
    ElseIf InStr(1, xlsRef.Cells(i, 3), "Non") = 0 And xlsRef.Cells(i, 1) = 700 Then ' Nuclear
        ' nothing here yet
    End If
    
    Set FindRng = Nothing
    Set xlsRemoteSheet = Nothing
    xlsRemoteWB.Close False
    Set xlsRemoteWB = Nothing
    xlsRemoteApp.Quit
    Set xlsRemoteApp = Nothing
    
Next i
Set xlsRef = Nothing
Set xlsSheet = Nothing
Set xlsWB = Nothing
Set xlsApp = Nothing
SlowVBA
Exit Function
ErrHandler:
SlowVBA
MsgBox Err.Number & " - " & Err.Description
Set FindRng = Nothing
Set xlsRemoteSheet = Nothing
xlsRemoteWB.Close False
Set xlsRemoteWB = Nothing
xlsRemoteApp.Quit
Set xlsRemoteApp = Nothing
Set xlsRef = Nothing
Set xlsSheet = Nothing
Set xlsWB = Nothing
Set xlsApp = Nothing
End Function

Function FastVBA()
Statuslabel.Show
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
End Function

Function SlowVBA()
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Unload Statuslabel
End Function

Function ShopArray() As Variant
Dim Shops() As Variant
ReDim Shops(1 To 14)
Shops(1) = "11"
Shops(2) = "17"
Shops(3) = "26"
Shops(4) = "31"
Shops(5) = "38"
Shops(6) = "41"
Shops(7) = "51"
Shops(8) = "56"
Shops(9) = "57"
Shops(10) = "64"
Shops(11) = "67"
Shops(12) = "71"
Shops(13) = "72"
Shops(14) = "99"
ShopArray = Shops
End Function

Function LinkCell(strFileName As String, strSheetName As String, strCell As String) As String
Dim strFile As String, strTmp As String
strFile = Mid(strFileName, InStrRev(strFileName, "\") + 1, Len(strFileName) - InStrRev(strFileName, "\"))
strTmp = strFileName
strTmp = Left(strTmp, (InStrRev(strTmp, "\")))
strFileName = strTmp
LinkCell = "='" & strFileName & "[" & strFile & "]" & strSheetName & "'!" & strCell
End Function

Function ColLett(Col As Long) As String
     
    If Col > 26 Then
        ColLett = ColLett((Col - (Col Mod 26)) / 26) + Chr(Col Mod 26 + 64)
    Else
        ColLett = Chr(Col + 64)
    End If
     
End Function

I have mentioned some parts of this project here before and had gotten some help and I thank you very much but I could use a little bit of guidance as all of the websites I have researched on seem to come up short for a solution to this problem (at least that I have noticed).

Thanks,

TheChazm

 

[thechazm]

Please disregard this question as I found out why it's still being slow. Even thought I disable the EnableEvents option for the excel application anytime a formula involves a number it automatically turns this back on which evaluates all of the forumulas for linked cells. I just changed it to copy the data instead and have gotten it to under 30 seconds now instead of 12-20 minutes.