Search for String and Copy in VBA

[wibni]

Hello,
I'm using Excel 2003.
In my table below I'm trying to copy the description from column B to column K (starting at row 9).
I'm only looking at the rows that have 'Site' in colum A.
The way it finds the correct description is by looking for the string in column J (starting at row 9).
For example in Cell J9 the number is '055'.
'055' is found on row 2, therfore get the description from B2 and copy to K9.
If there are only characters like in J16, simply copy J16 to K16.

I currently have it working in a vlookup but now require the lookup table to be on the same sheet in the format shown.
My vlookup formula is like this:
=IF(ISNUMBER(J9+0),VLOOKUP(J9,Rigs!A$1:B$18,2,FALSE),J9)

How can I achieve this in VBA?

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K
1	Location	Desc	Sum Rigs
2	Site	GGM	6	008	028	038	055	066	073
3	Site	NMM	8	005	011	021	024	032	042	048	049
4	Office	MWA	14	008	028	038	055	066	073	005	011
5	Office	KNC	14	008	028	038	055	066	073	005	011
6
7
8										RigSite	Site
9										055	GGM
10										066	GGM
11										073	GGM
12										008	GGM
13										028	GGM
14										055	GGM
15										066	GGM
16										NMM	NMM
17										005	NMM
Sheet1

 

[AlphaFrog]

Sub Site_Lookup()
    
    Dim rngSites As Range, rngLookup As Range, cell As Range, found As Range
    
    Set rngSites = Range("D2:K3")
    Set rngLookup = Range("J9:J17")
    
    For Each cell In rngLookup
        If cell.Value <> "" Then
            If IsNumeric(cell) Then
                Firstfound = ""
                Set found = rngSites.Find(cell.Value, , xlValues, xlWhole, xlByRows, xlNext, False)
                If Not found Is Nothing Then
                    ' Site found
                    cell.Offset(, 1).Value = Range("B" & found.Row).Value
                Else
                    ' No Match
                    cell.Offset(, 1).Value = "N\A"
                End If
            Else
                ' Text
                cell.Offset(, 1).Value = cell.Value
            End If
        End If
    Next cell
    
End Sub

 

[wibni]

Thank you so much!
This works very well!