how to optimize finding matching values macro speed

Dear all,

I am writing to seek help in optimizing the following macro below, as is freezes and displays the out put after 10/15 minutes.

I have posted a same thread on the following forum below but did not get any response:

http://www.mrexcel.com/forum/excel-q...tch-value.html

Option Explicit
Sub FindNamesV3()

Dim g As Variant
Dim lr1 As Long, lr2 As Long, i As Long, fb As Long, fc As Long
Application.ScreenUpdating = False
lr1 = Sheets("Sheet1").Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row + 1
With Sheets("Sheet2")
  .Columns("I:I").ClearContents
  lr2 = .Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row + 1
  g = .Range("G1:I" & lr2)
  For i = 1 To UBound(g, 1)
    If g(i, 1) = "" And g(i, 2) = "" Then
      'do nothing
    ElseIf g(i, 1) <> "" And g(i, 2) = "" Then
      fb = 0
      On Error Resume Next
      fb = Application.Match(g(i, 1), Sheets("Sheet1").Range("B1:B" & lr1), 0)
      On Error GoTo 0
      If fb > 0 Then
        g(i, 3) = Sheets("Sheet1").Range("A" & fb).Value
      End If
    ElseIf g(i, 1) = "" And g(i, 2) <> "" Then
      fc = 0
      On Error Resume Next
      fc = Application.Match(g(i, 2), Sheets("Sheet1").Range("C1:C" & lr1), 0)
      On Error GoTo 0
      If fc > 0 Then
        g(i, 3) = Sheets("Sheet1").Range("A" & fc).Value
      End If
    ElseIf g(i, 1) <> "" And g(i, 2) <> "" Then
      fb = 0
      On Error Resume Next
      fb = Application.Match(g(i, 1), Sheets("Sheet1").Range("B1:B" & lr1), 0)
      On Error GoTo 0
      If fb > 0 Then
        g(i, 3) = Sheets("Sheet1").Range("A" & fb).Value
      End If
      fc = 0
      On Error Resume Next
      fc = Application.Match(g(i, 2), Sheets("Sheet1").Range("C1:C" & lr1), 0)
      On Error GoTo 0
      If fc > 0 Then
        g(i, 3) = Sheets("Sheet1").Range("A" & fc).Value
      End If
    End If
  Next i
  .Range("G1:I" & lr2) = g
  .Columns(9).AutoFit
  Erase g
  .Activate
End With
Application.ScreenUpdating = True
MsgBox "Sheet2 column I returned " & Application.CountA(Sheets("Sheet2").Columns("I:I")) & " names from Sheet1 column A."
End Sub

Thank you for your time and help.