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

Khan kashaf

New Member
Joined
May 11, 2021
Messages
14
Office Version
  1. 2019
  2. 2016
  3. 2010
Platform
  1. Windows
  2. MacOS
  3. Mobile
  4. Web
VBA Code:
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
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

StephenCrump

MrExcel MVP
Joined
Sep 18, 2013
Messages
4,400
Office Version
  1. 365
Platform
  1. Windows
It's slow constantly switching between VBA and Excel, and writing to Excel cell by cell.

VBA Code:
'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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,127
Messages
5,768,286
Members
425,460
Latest member
Astros1243

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top