I am very much a novice with VBA but i have managed to write code that runs. My issue is that when i run it with many thousands of rows it basically grinds to a halt and nothing happens for well over an hour (when i run for 150K rows). On top of my code i have added:
I have also attempted to avoid using .select whenever i could. Is there anything that i'm missing or is there a way that i could improve my code? Since i've pasted various code i'm sure i've done something wrong.
Sub Eng11()
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Last As Long
Dim i As Long
Dim wkb1 As Workbook
Dim sht1 As Worksheet
Dim wkb2 As Workbook
Dim sht2 As Worksheet
Dim lastrow As Long
Dim sPath As String, sFile As String
Dim wb As Workbook
Dim x As Long
Dim ws As Worksheet
sPath = "C:\Users\nascd\Downloads\Pronto Master\"
sFile = sPath & Sheets("Sheet 1").Range("J2").Text
Set wkb1 = ThisWorkbook
Set wkb2 = Workbooks.Open(sFile)
Set sht1 = wkb1.Sheets("Data Table")
Set sht2 = wkb2.Sheets("Sheet1")
Set ws = sht2
Last = Cells(Rows.Count, "AX").End(xlUp).Row
For i = Last To 2 Step -1
If (Cells(i, "AZ").Text) = (Cells(i, "AB").Text) And _
(Cells(i, "BA").Text) = (Cells(i, "AC").Text) And _
(Cells(i, "AY").Text) = "C" And (Cells(i, "AA").Text) = "E" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
Next i
For i = Last To 2 Step -1
If (Cells(i, "AZ").Text) = (Cells(i, "AB").Text) And _
(Cells(i, "BA").Text) = (Cells(i, "AC").Text) And _
(Cells(i, "AY").Text) = "C" And (Cells(i, "AA").Text) = "T" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
Next i
For i = Last To 2 Step -1
If (Cells(i, "AY").Text) = "1" And (Cells(i, "AA").Text) = "E" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
Next i
For i = Last To 2 Step -1
If (Cells(i, "AY").Text) = "2" And (Cells(i, "AA").Text) = "E" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
Next i
End Sub
I think that this is as condensed as I can make it. Certainly some logic magician could come in and make this shorter but I think they might not be able to fit the if
logic onto a single line!
This will only loop once, which should have been your biggest obstacle in terms of time to run. I made sure to specify that you're searching in sht2
, removed some unused variables, and made sure to reset your application
settings at the end of the sub. Other than that, the only thing I really did was combine your if
statements as best as I could and put them into one loop.
Sub Eng11()
With Application
.DisplayAlerts = False
.AskToUpdateLinks = False
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Dim sht1 As Worksheet
Set sht1 = ThisWorkbook.Sheets("Data Table")
Dim sPath As String
sPath = "C:\Users\nascd\Downloads\Pronto Master\"
Dim sFile As String
sFile = sPath & sht1.Range("J2").Value2
Dim sht2 As Worksheet
Set sht2 = Workbooks.Open(sFile).Sheets(1)
Dim lastRow As Long
lastRow = sht2.Cells(Rows.count, "AX").End(xlUp).row
Dim i As Long
For i = 2 To lastRow
With sht2
If .Cells(i, "AZ").Value2 = .Cells(i, "AB").Value2 And _
.Cells(i, "BA").Value2 = .Cells(i, "AC").Value2 Then
If .Cells(i, "AY").Value2 = "C" And _
(.Cells(i, "AA").Value2 = "E" Or .Cells(i, "AA").Value2 = "T") Then
.Cells(i, "AX").Value2 = .Cells(i, "Z").Value2
.Cells(i, "AY").Value2 = .Cells(i, "AA").Value2
.Cells(i, "AZ").Value2 = .Cells(i, "AB").Value2
.Cells(i, "BA").Value2 = .Cells(i, "AC").Value2
End If
ElseIf .Cells(i, "AA").Value2 = "E" And _
(.Cells(i, "AY").Value2 = 2 Or .Cells(i, "AY").Value2 = 1) Then
.Cells(i, "AX").Value2 = .Cells(i, "Z").Value2
.Cells(i, "AY").Value2 = .Cells(i, "AA").Value2
.Cells(i, "AZ").Value2 = .Cells(i, "AB").Value2
.Cells(i, "BA").Value2 = .Cells(i, "AC").Value2
End If
End With
Next i
With Application
.DisplayAlerts = True
.AskToUpdateLinks = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
Sub Eng11()
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Last As Long
Dim i As Long
Dim wkb1 As Workbook
Dim sht1 As Worksheet
Dim wkb2 As Workbook
Dim sht2 As Worksheet
Dim lastrow As Long
Dim sPath As String, sFile As String
Dim wb As Workbook
Dim x As Long
Dim ws As Worksheet
sPath = "C:\Users\nascd\Downloads\Pronto Master\"
sFile = sPath & Sheets("Sheet 1").Range("J2").Text
Set wkb1 = ThisWorkbook
Set wkb2 = Workbooks.Open(sFile)
Set sht1 = wkb1.Sheets("Data Table")
Set sht2 = wkb2.Sheets("Sheet1")
Set ws = sht2
Last = Cells(Rows.Count, "AX").End(xlUp).Row
For i = Last To 2 Step -1
If (Cells(i, "AZ").Text) = (Cells(i, "AB").Text) And _
(Cells(i, "BA").Text) = (Cells(i, "AC").Text) And _
(Cells(i, "AY").Text) = "C" And (Cells(i, "AA").Text) = "E" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
If (Cells(i, "AZ").Text) = (Cells(i, "AB").Text) And _
(Cells(i, "BA").Text) = (Cells(i, "AC").Text) And _
(Cells(i, "AY").Text) = "C" And (Cells(i, "AA").Text) = "T" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
If (Cells(i, "AY").Text) = "1" And (Cells(i, "AA").Text) = "E" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
If (Cells(i, "AY").Text) = "2" And (Cells(i, "AA").Text) = "E" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
Next i
End Sub
Can you pardon to let me the know the difference of last two Ifs as the function is same for both ifs condition.
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.