Copy/paste values on two sheets

Question

I'm trying to copy values from one sheet to another sheet if a value exists. The code runs great on around 500 rows but very slowly on 5000 rows.

Is there any way I can speed it up?

Option Explicit
Public Sub ExampleCycleCount()
 ' updating off
 With Application
 .ScreenUpdating = False
 .EnableEvents = False
 .DisplayAlerts = False
 .Calculation = xlManual
 End With
 Dim FileName As String
 Dim FilePath As String
 FileName = Format(Now, "YYYY MM DD HHMM") & " " & _
 Sheets("WarehouseInventory").Range("A1").Text
 FilePath = Environ("USERPROFILE") & "\Documents\Cycle Count"
 Debug.Print FileName
 ActiveWorkbook.SaveAs FileName:=FilePath & "\" & FileName
 ' Check if active sheet name is scan report
 If Not ActiveWorkbook.ActiveSheet.Name = "Scan Report" Then
 ActiveWorkbook.ActiveSheet.Name = "Scan Report"
 End If
 Dim SCAN_REPORT As Worksheet
 Dim INVENTORY_REPORT As Worksheet
 Set SCAN_REPORT = ActiveWorkbook.Worksheets("Scan Report")
 Set INVENTORY_REPORT = ActiveWorkbook.Worksheets("WarehouseInventory")
 ' Add top row for heading -
 With SCAN_REPORT
 If Not [A1].Value = "LPN" Then
 Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
 [A1].Value = "LPN"
 [B1].Value = "PART NUMBER"
 [C1].Value = "SERIAL NUMBER"
 [D1].Value = "SYSTEM BIN"
 [E1].Value = "SCANNED BIN"
 [F1].Value = "COMMENT'S"
 End If
 ' set filter mode
 If ActiveSheet.AutoFilterMode = False Then
 [A1].AutoFilter
 End If
 With ActiveWindow
 .SplitColumn = 0
 .SplitRow = 1
 .FreezePanes = True
 End With
 End With
 Dim i%, x% ' as long
 i = 2 ' Start on row 2 - SCAN_REPORT
 x = 3 ' Start on row 3 - INVENTORY_REPORT
 Dim BIN_NUM As String
 Dim LPN_NUM As String
 With SCAN_REPORT
 Do Until IsEmpty(.Columns(1).Cells(i))
 DoEvents
 If Len(.Columns(1).Cells(i).Value) <= 6 Then
 BIN_NUM = .Columns(1).Cells(i).Value
 Debug.Print BIN_NUM 'Immediate Window
 End If
 If Len(.Columns(1).Cells(i).Value) = 12 Then
 Debug.Print .Columns(1).Cells(i).Address
 LPN_NUM = .Columns(1).Cells(i).Value
 With INVENTORY_REPORT
 Do Until IsEmpty(.Columns(1).Cells(x))
 DoEvents
 If .Columns(1).Cells(x).Value = LPN_NUM Then
 ' Copy Paste from inventory to scan sheet
 SCAN_REPORT.Columns(1).Cells(i).Offset(0, 1).Value = _
 INVENTORY_REPORT.Columns(1).Cells(x).Offset(0, 1).Value
 SCAN_REPORT.Columns(1).Cells(i).Offset(0, 2).Value = _
 INVENTORY_REPORT.Columns(1).Cells(x).Offset(0, 2).Value
 SCAN_REPORT.Columns(1).Cells(i).Offset(0, 3).Value = _
 INVENTORY_REPORT.Columns(1).Cells(x).Offset(0, 3).Value
 SCAN_REPORT.Columns(1).Cells(i).Offset(0, 4).Value = BIN_NUM
 ' Check if bin row match
 If Not SCAN_REPORT.Columns(1).Cells(i).Offset(0, 3) _
 .Value = BIN_NUM Then
 SCAN_REPORT.Columns(1).Cells(i).Offset(0, 5) _
 .Value = "SYSTEM/SCAN BIN DON'T MATCH"
 End If
 Exit Do
 End If
 x = x + 1
 Loop
 x = 2
 End With 'INVENTORY_REPORT
 If SCAN_REPORT.Columns(1).Cells(i).Offset(0, 4).Value = "" Then
 SCAN_REPORT.Columns(1).Cells(i).Offset(0, 4).Value = BIN_NUM
 SCAN_REPORT.Columns(1).Cells(i).Offset(0, 5).Value = "LPN NOT FOUND"
 End If
 Else
 If Len(.Columns(1).Cells(i).Value) >= 7 Then
 SCAN_REPORT.Columns(1).Cells(i).Offset(0, 5) _
 .Value = "ERROR / SCANNED IN " & BIN_NUM
 End If
 End If
 i = i + 1
 Loop
 End With 'SCAN_REPORT
 With INVENTORY_REPORT
 .Range("H2").Value = "COMMENTS'S"
 .Range("H2").Font.Bold = True
 .Range("A2").AutoFilter
 End With
 x = 0 ' INVENTORY_REPORT
 i = 0 ' SCAN_REPORT
 Dim List As Scripting.Dictionary
 Set List = New Scripting.Dictionary
 With SCAN_REPORT
 Dim Rpt_LRow As Long
 Rpt_LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
 Dim Rpt_Data() As Variant
 Rpt_Data = .Range(.Cells(1, 1), .Cells(Rpt_LRow, 1)).Value
 For x = LBound(Rpt_Data) To UBound(Rpt_Data) Step 1
 DoEvents
 Debug.Print Rpt_Data(x, 1)
 On Error Resume Next ' For duplicates
 List.Add Rpt_Data(x, 1), x
 On Error GoTo 0
 Next
 End With
 With INVENTORY_REPORT
 Dim Inv_LRow As Long
 Inv_LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
 Dim Inv_Data() As Variant
 Inv_Data = .Range(.Cells(1, 1), .Cells(Inv_LRow, 1)).Value
 For i = LBound(Inv_Data) To UBound(Inv_Data) Step 1
 DoEvents
 If List.Exists(Inv_Data(i, 1)) Then
 .Columns(1).Cells(i).Offset(0, 7).Value = "LPN SCANNED"
 Else
 .Columns(1).Cells(i).Offset(0, 7).Value = "LPN NOT SCAN"
 End If
 Next
 End With
 ' Check for dupes
 With SCAN_REPORT.Range("A:A")
 .FormatConditions.AddUniqueValues
 .FormatConditions(1).DupeUnique = xlDuplicate
 .FormatConditions(1).Interior.Color = 13551615
 End With
 With Application
 .ScreenUpdating = True
 .EnableEvents = True
 .DisplayAlerts = True
 .Calculation = xlAutomatic
 End With
End Sub

• Raystafarian: Why are you using Debug.Print?
• 0m3r: @Raystafarian Just for testing, it will get removed once the code is ready-
• Ryan Wildry: Can you post a sample workbook, might be easier to recommend performance tweaks understanding the full context.

Answer 1

There are a lot of aspects to this code. I'll just address your loops, but first

First - while this notation works

If .Columns(1).Cells(x).Value = LPN_NUM Then

It's not standard. It's actually very strange.

If .Cells(x,1) = LPN_NUM

Is more like how it would be expected to be used.

---

Loops

I don't like DO UNTIL loops. I especially don't like a DO UNTIL in my DO UNTIL. Also, let's take a look at these

With SCAN_REPORT
 Do Until IsEmpty(.Columns(1).Cells(i))
 DoEvents
 With INVENTORY_REPORT
 Do Until IsEmpty(.Columns(1).Cells(x))
 DoEvents
 x = x + 1
 Loop
 x = 2
 End With
 i = i + 1
 Loop
End With

What's happening here? I can't really tell by just looking at it. Let's start with some structure -

 Dim scanLastRow As Long
 Dim inventoryLastRow As Long
 scanLastRow = SCAN_REPORT.Cells(Rows.Count, 1).End(xlUp).Row
 inventoryLastRow = INVENTORY_REPORT.Cells(Rows.Count, 1).End(xlUp).Row

Okay, now we can use some FOR NEXT loops

 For x = 1 To scanLastRow
 With INVENTORY_REPORT
 For i = 1 To inventoryLastRow
 Next
 End With
 Next

Right, that feels better.

Dim Rpt_LRow As Long
Rpt_LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Dim Inv_LRow As Long
Inv_LRow = .Cells(.Rows.Count, 1).End(xlUp).Row

Look, in fact you've already written that code.

---

Okay, let's talk about speed in your loops.

Things like this

SCAN_REPORT.Columns(1).Cells(i).Offset(0, 1).Value = _
 INVENTORY_REPORT.Columns(1).Cells(x).Offset(0, 1).Value

Take a lot of resources. Especially within two DO UNTIL loops. Looking at it, it kind of looks like you want something like this

Dim invArray As Variant
Dim scanArray As Variant
Dim scanLastRow As Long
Dim inventoryLastRow As Long
scanLastRow = SCAN_REPORT.Cells(Rows.Count, 1).End(xlUp).Row
inventoryLastRow = INVENTORY_REPORT.Cells(Rows.Count, 1).End(xlUp).Row
scanArray = SCAN_REPORT.Range(.Cells(1, 1), .Cells(scanLastRow, 4))
inarray = INVENTORY_REPORT.Range(.Cells(1, 1), .Cells(inventoryLastRow, 4))
Dim scanIndex As Long
Dim invIndex As Long
For scanIndex = LBound(scanArray) To UBound(scanArray)
 LPN_NUM = scanArray(scanIndex)
 For invIndex = LBound(invArray) To UBound(invArray)
 If invArray(invIndex) = LPN_NUM Then
 'stuff
 Else
 'other stuff
 End If
 Next
Next

Now you can loop through the items in the arrays rather than on the sheet. Populate the arrays and then put the array on the sheet in one fell swoop.