More efficient alternative to Find-Replace Loop?

Thanks, SHG and Leith. I'll play with this later today and see how it goes. Happy Groundhogs Day!

Leith... amazing. With some adjustments I have the entire macro (creating array, adding it to new sheet, creating DSO, replacing values) running in about 3 seconds.

I'll definitely have to use DSO more in the future. Thanks a ton!

Adjusted code shown below. Only thing I noticed is that for cells that weren't replaced, if they were numeric format they were converted to currency format. To get around that I just formatted the entire replacement range as text ahead of the replacement step.

Option Base 1
Option Explicit

Sub ReplaceStuff()
Dim arr(2, 629) As Variant
Application.ScreenUpdating = False
arr(1, 1) = "19142"
arr(1, 2) = "19144"
arr(1, 3) = "19146"
.
.
arr(1, 627) = "E98"
arr(1, 628) = "E99"
arr(1, 629) = "E06500"
arr(2, 1) = "Company A"
arr(2, 2) = "Company B"
arr(2, 3) = "Company C"
.
.
arr(2, 627) = "Long Description X"
arr(2, 628) = "Long Description Y"
arr(2, 629) = "Long Description Z"

Sheets.Add.Name = "CodeList"
With Sheets("CodeList")
    .Range("A:B").NumberFormat = "@"
    .Range("A1:B" & UBound(arr, 2)).Value = Application.Transpose(arr)
End With
Call ReplacementDSO
Application.DisplayAlerts = False
Sheets("CodeList").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub ReplacementDSO()

  Dim C As Long, Data() As Variant, DSO As Object
  Dim I As Long, R As Long, Rng As Range, lr As Long
  Dim lcode As Long
  
    Set DSO = CreateObject("Scripting.Dictionary")
    DSO.CompareMode = vbTextCompare
      lcode = Sheets("CodeList").Range("A" & Rows.Count).End(xlUp).Row
      Set Rng = Worksheets("CodeList").Range("A1:B" & lcode)
      
        For I = 1 To lcode
          If Not DSO.Exists(Rng.Item(I, 1)) Then
             DSO.Add Rng.Item(I, 1).Value, Rng.Item(I, 2).Text
          End If
        Next I
        
        lr = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
        Set Rng = Worksheets("Sheet1").Range("A25:I" & lr)
        Rng.NumberFormat = "@"
        ReDim Data(1 To lr - 24, 1 To 9)
        Data = Rng.Value
          
          For R = 1 To lr - 24
            For C = 1 To 9
              If DSO.Exists(Data(R, C)) Then Data(R, C) = DSO(Data(R, C))
            Next C
          Next R
          
      Rng.Value = Data
      Set DSO = Nothing
End Sub

Good job, Leith!