简体   繁体   中英

Excel VBA Do While Loop on 50k+ rows of data, 30+ minutes To Process

I am running a Do While Loop on a large excel file w/ 50k+ rows of inventory data and for the macro to sort through the data it takes my computer (mobile i5 6300u, 8gb ram) over 40 minutes to process (this is the point where I gave up and closed the program).

Is there a better way to go about this that is less taxing? I am considering having the macro paste a value in the first row and copy it down to the last row like i would manually and pasting values.

I have researched a bit into converting the Data into an array, but have yet to find something on running a Do While Loop on something like that. I do not have experience in VBA w/ arrays and their application. For frame of reference, I have experience in processing something like this in R which would be a breeze, but no one in my office uses that, so I have to use VBA.

Any help is appreciated!

Sub AutoINV()
Dim row
Dim lastrow
Dim x As Workbook
Dim y As Workbook

'## Open workbook first:
Set x = Workbooks.Open("x.xls")
Set y = Workbooks.Open("y.xlsx")

    x.Sheets("x.xls").Range("A1:aa60000").Copy
    Windows("y.xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste

'Close x:
x.Close


row = 2
lastrow = Sheets("Inv_Datatable").Range("a100000").End(xlUp).row
Set x = Workbooks.Open("y.xlxs")

Do While row <= lastrow
'1DIG LBL
If Left(y.Sheets("Inv_Datatable").Range("Z" & row), 2) = "RM" Then
y.Sheets("Inv_Datatable").Range("AB" & row) = ""
Else: y.Sheets("Inv_Datatable").Range("AB" & row) = Right(y.Sheets("Inv_Datatable").Range("Af" & row), 1)
End If
y.Sheets("Inv_Datatable").Range("ad" & row) = Left(y.Sheets("Inv_Datatable").Range("h" & row), 5) 'Lic
y.Sheets("Inv_Datatable").Range("ae" & row) = Application.VLookup(y.Sheets("Inv_Datatable").Range("Af" & row), x.Worksheets("StyleMaster").Range("a1:az40000"), 26, 0) 'RMUPC
y.Sheets("Inv_Datatable").Range("af" & row) = y.Sheets("Inv_Datatable").Range("i" & row) & y.Sheets("Inv_Datatable").Range("j" & row) 'Full Style
'Country
If (Left(y.Sheets("Inv_Datatable").Range("Ac" & row), 1) = "D" And Right(y.Sheets("Inv_Datatable").Range("Ac" & row), 1) = "S") Or (Left(y.Sheets("Inv_Datatable").Range("Ac" & row), 1) = "D" And Right(y.Sheets("Inv_Datatable").Range("Ac" & row), 1) = "C") Then
y.Sheets("Inv_Datatable").Range("Ac" & row) = "USA"
Else:
If Left(y.Sheets("Inv_Datatable").Range("Ac" & row), 1) = "D" Or Left(y.Sheets("Inv_Datatable").Range("Ac" & row), 1) = "C" Then
y.Sheets("Inv_Datatable").Range("Ac" & row) = "CAN"
Else: y.Sheets("Inv_Datatable").Range("Ac" & row) = "USA"
End If
End If
y.Sheets("Inv_Datatable").Range("ag" & row) = Mid(y.Sheets("Inv_Datatable").Range("af" & row), 2, 1) & "_" 'Mid 2,1
y.Sheets("Inv_Datatable").Range("ah" & row) = y.Sheets("Inv_Datatable").Range("ag" & row) & y.Sheets("Inv_Datatable").Range("g" & row) 'Code
    If y.Sheets("Inv_Datatable").Range("ac" & row) = "CAN" And Left(y.Sheets("Inv_Datatable").Range("af" & row), 1) = "C" Then
    y.Sheets("Inv_Datatable").Range("u" & row) = ""
    row = row + 1
    Else: row = row + 1
    End If
Loop

ActiveWorkbook.RefreshAll

End Sub

Before the loop, disable some items:

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

Enable after the loop:

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM