Sub Text_Coding()
'Please save Keywords in column 1 of sheet2 and corresponding codes in column 2 in the same sheet
'Save Text in column 1 of sheet1 after running this macro it will generate codes in column 2 in this sheet
Dim txt As Variant
n = Sheet1.Cells.SpecialCells(xlCellTypeLastCell).Row
m = Sheet2.Cells.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To n
Sheet1.Cells(i, 2) = ""
Set searchRange = Sheet1.Cells(i, 1)
For key_w = 2 To m
Set FoundCell = searchRange.Find(what:=Sheet2.Cells(key_w, 1))
If Not FoundCell Is Nothing Then
If (Len(Sheet1.Cells(i, 2)) > 0) Then
Sheet1.Cells(i, 2) = Sheet2.Cells(key_w, 2) & "," & Sheet1.Cells(i, 2)
Else
Sheet1.Cells(i, 2) = Sheet2.Cells(key_w, 2)
End If
End If
Next
Next
End Sub
Friday, July 10, 2009
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment