VBA Find Loop takes too long

[Lil Stinker]

I'm using the code below (courtesy of @DanteAmor) to find and match serial numbers listed on two different sheets. Sheet 1 is where the serial numbers are entered by the user. Sheet 2 is the inventory of existing serial numbers. The code finds the numbers that are input on Sheet 1, matches them on Sheet 2 and updates the status as IN or OUT, adds a location and the date. The problem is it works fine on a small data set for testing however, the actual inventory list contains around 3000 entries. Just trying to match 13 serial numbers from Sheet 1 on Sheet 2 takes Excel almost a full minute to process. There could potentially be a few hundred serial numbers entered on Sheet 1 which I imagine could end up crashing Excel. Not to mention the inventory increasing beyond 3000 entries.

Is there a way to improve the existing code to run faster? I've already tried disabling ScreenUpdating, Calculation and EnableEvents with no improvement. I've also tried shortening the Range from "B:B" to "B2:B9999", still no faster. Looking for any ideas.

Sub out_serial_number_v2()
  Dim rng As Range, c As Range, f As Range
  Dim dt As Date, lo As String, cad As String
  
  With Sheets("Sheet1")
    Set rng = .Range("B11:O90")
    dt = .Range("A1").Value
    lo = .Range("H1").Value
  End With
  
  For Each c In rng
    If c.Value <> "" Then
      With Sheets("Sheet2")
        Set f = .Range("B:B").Find(c.Value, , xlValues, xlWhole, , , False)
        If Not f Is Nothing Then
          .Range("E" & f.Row).Value = "OUT"
          .Range("F" & f.Row).Value = lo
          .Range("G" & f.Row).Value = dt
        Else
          cad = cad & c.Value & vbCr
        End If
      End With
    End If
  Next
  If cad <> "" Then
    MsgBox cad, , "Serial number was not found in inventory"
  End If
End Sub

 

[DanteAmor]

Dante, you're a maestro! Works like a charm! Speed: 0.05 seconds

Just one more thing and I'm not sure if it requires a separate post. How can I go about reversing this process if the user needs to remove serial numbers after they've been recorded to Sheet2? Reversing it meaning, changing c(wRow, 1) = "IN" and clearing out lo and dt when the serial number is deleted on Sheet1. Would this require a separate sub with a designed pop-up Delete button or is there some way of catching the delete event when using the Backspace or Delete button on the keyboard?

Thank you for your kind comments.

When you run a macro it is not possible to undo it with backspace.

Create a new thread, you must explain in detail how this process would be done.

Have a nice day

 

[Lil Stinker]

@Flashbond I'm not sure why but it still just hangs.

 

[Lil Stinker]

Thank you for your kind comments.

When you run a macro it is not possible to undo it with backspace.

Create a new thread, you must explain in detail how this process would be done.

Have a nice day

Thank you, sir! I believe I may have a workaround for it so I'll give it a shot first.