T4011_Transfer Data By Application Match Tutorial

https://excel-egy.com/forum/t4011
---------------------------------

'In Worksheet (RESULT) Module
'----------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("C2"), Target) Is Nothing Then
        Call Transfer_Data
    End If
End Sub

'In Standard Module
'------------------
Sub Transfer_Data()
    Dim x, ws As Worksheet, sh As Worksheet

    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets("DATA")
        Set sh = ThisWorkbook.Worksheets("RESULT")

        x = Application.Match(sh.Range("C2").Value, ws.Columns(1), 0)
        If Not IsError(x) Then
            With sh
                .Range("C3").Value = ws.Cells(x, 6).Value
                .Range("C4").Value = ws.Cells(x, 2).Value
                .Range("I2").Value = ws.Cells(x, 9).Value
                .Range("I4").Value = ws.Cells(x, 5).Value
            End With
        Else
            sh.Range("C3,C4,I2,I4").Value = ""
            MsgBox "Number Not Exists", vbExclamation
        End If
    Application.ScreenUpdating = True
End Sub