I am new to VBA and I have created a working VBA that copies data from one worksheet to another, preforms vlookup, and calculation. What I am looking for is help to streamline my if statement to run faster. I preform this exact same If Statement a total of six times looking at six different columns from my data source to pull in my needed data. Right now I am looking at about 3500 lines and it is taking three minutes to run the macros. I am using excel 365.
Any help would be greatly appreciated. Thank you in advance!
Any help would be greatly appreciated. Thank you in advance!
VBA Code:
Sub CopyBatchRecord()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim UnrestCol As Range
Dim Status As Range
Dim PasteCell As Range 'A
Dim QtyCell As Range 'H
Dim SUoMCell As Range 'K
Dim DUoMCell As Range 'M
Dim MidCell As Range 'P
Dim QualCol As Range
Dim BlockedCol As Range
Dim StktfrCol As Range
Dim RestrCol As Range
Dim ReturnsCol As Range
Set UnrestCol = Sheet1.Range("G2", Sheet1.Range("G2").End(xlDown))
Set QualCol = Sheet1.Range("I2", Sheet1.Range("I2").End(xlDown))
Set BlockedCol = Sheet1.Range("K2", Sheet1.Range("K2").End(xlDown))
Set StktfrCol = Sheet1.Range("M2", Sheet1.Range("M2").End(xlDown))
Set RestrCol = Sheet1.Range("O2", Sheet1.Range("O2").End(xlDown))
Set ReturnsCol = Sheet1.Range("Q2", Sheet1.Range("Q2").End(xlDown))
Sheet2.Rows("2:" & Rows.Count).ClearContents
For Each Status In UnrestCol
If Sheet2.Range("A2") = "" Then
Set PasteCell = Sheet2.Range("A2")
Set QtyCell = Sheet2.Range("H2")
Set SUoMCell = Sheet2.Range("K2")
Set DUoMCell = Sheet2.Range("M2")
Set MidCell = Sheet2.Range("P2")
Else
Set PasteCell = Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Set QtyCell = Sheet2.Range("H" & Rows.Count).End(xlUp).Offset(1, 0)
Set SUoMCell = Sheet2.Range("K" & Rows.Count).End(xlUp).Offset(1, 0)
Set DUoMCell = Sheet2.Range("M" & Rows.Count).End(xlUp).Offset(1, 0)
Set MidCell = Sheet2.Range("P" & Rows.Count).End(xlUp).Offset(1, 0)
End If
If Status > "0" Then Status.Offset(0, -6).Resize(1, 6).Copy PasteCell
If Status > "0" Then Status.Offset(0, 0).Resize(1, 2).Copy QtyCell
If Status > "0" Then Status.Offset(0, 12).Resize(1, 1).Copy SUoMCell
If Status > "0" Then Status.Offset(0, 13).Resize(1, 1).Copy DUoMCell
If Status > "0" Then Status.Offset(0, 14).Resize(1, 11).Copy MidCell
If Status > "0" Then Sheet2.Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = "Unrestricted"
Next Status
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub