Vlookup is not running when working with 4 lakh of data in for loop

[Khan kashaf]

Sub fetch_data()
Dim arr()
Dim arr3()
Dim arrp()
Dim arr1()
Dim filteredArray()
Dim totalRange
Dim i, j
Dim Str
Dim endRange As Range
Dim wb As Workbook
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False



Path = ActiveWorkbook.Path
masterPath = Path & "\" & "Master File.xlsb"
If Dir(masterPath) <> "" Then
    Set wb = Workbooks.Open(masterPath)
        wb.Sheets("Grid").Select
        Set endRange = Range("A1").SpecialCells(xlCellTypeLastCell)
        totalRange = Range("A1:" & endRange.Address)
        arr = totalRange
       
        wb.Close
Else
    MsgBox "The following file could not be found " & masterPath
    Exit Sub
End If


ReDim Preserve filteredArray(1 To UBound(arr, 1), 1 To 5)
    Dim counter As Long
    counter = 0
    For i = LBound(arr, 1) To UBound(arr, 1)
       
        If (i <> 1 And arr(i, 1) <> Empty And arr(i, 2) <> Empty And arr(i, 3) <> "SMTF") Then
            counter = counter + 1
            filteredArray(counter, 1) = arr(i, 1)
            filteredArray(counter, 2) = arr(i, 2)
            filteredArray(counter, 3) = arr(i, 4)
            filteredArray(counter, 4) = arr(i, 5)
        End If

    Next
   
    ActiveWorkbook.Sheets("Sheet1").Select
    Range("A2:E" & UBound(arr, 1)).Value = filteredArray
    
    
   ActiveWorkbook.Sheets("Sheet1").Select
    Cells(1, 1).Value = "AccCode"
    Cells(1, 2).Value = "Account Name"
    Cells(1, 3).Value = "Debit amnt"
    Cells(1, 4).Value = "Credit amnt"
     Sheet7.PivotTables("PivotTable4").PivotCache.Refresh
 
    ActiveWorkbook.Sheets("Sheet6").Select
    LR = Worksheets("Sheet6").Cells(Rows.Count, 1).End(xlUp).Row
    arrp = Range("A2:C" & LR).Value ' all value of pivot table store in array



   ReDim Preserve arr3(1 To UBound(arrp, 1), 1 To 4)
    Dim counter1 As Long
    counter1 = 0
    For i = LBound(arrp, 1) To UBound(arrp, 1)
       
            counter1 = counter1 + 1
            arr3(counter1, 1) = arrp(i, 1)
            arr3(counter1, 2) = arrp(i, 2)
       

    Next
   
    ActiveWorkbook.Sheets("Working").Select
    Range("A2:C" & UBound(arrp, 1)).Value = arr3

       ActiveWorkbook.Sheets("Working").Select
       ThisWorkbook.Sheets("Working").Select
       Str = "\Details.xlsb"
       filepath1 = ThisWorkbook.Path

       mainpath = filepath1 & Str
       Set w1 = Workbooks.Open(mainpath)
       last2 = w1.Sheets("Client Group").Range("A" & Rows.Count).End(xlUp).Row
       Rng = w1.Sheets("Client Group").Range("A2:C" & last2)
       Set ws1 = ThisWorkbook.Sheets("Working")
       row1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
  
       For i = 2 To row1
       Application.StatusBar = "micro is running" & Round((i / 1000 * 100), 0) & "%"
       On Error Resume Next
       ws1.Range("C" & i).Value = Application.WorksheetFunction.VLookup(ws1.Range("A" & i), Rng, 3, False)

       Next
       Application.StatusBar = ""

    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    
   MsgBox "Done"
   
   
   End Sub

My lookup function is taking so much time and excel is not responding. In small data it runs properly.. but in approx 4 lakh data it is not working.. please help me . Thank you in advance

 

[StephenCrump]

It's slow constantly switching between VBA and Excel, and writing to Excel cell by cell.

'Is it any better if you replace this
For i = 2 To row1
    Application.StatusBar = "micro is running" & Round((i / 1000 * 100), 0) & "%"
    On Error Resume Next
    ws1.Range("C" & i).Value = Application.WorksheetFunction.VLookup(ws1.Range("A" & i), Rng, 3, False)
 Next
         
'with this
With ws1.Range("C2:C" & row1)
    .Formula = "=VLOOKUP(A2,'[Details.xlsb]Client Group'!A$2:C$" & last2 & ", 3, )"
    .Value = .Value
End With