It seems to me, if you build your list of interest from the text of the
entries, you will already have a list of misspellings. It would be far
easier to construct a cross walk table from that than what you are asking (I
would think).

--
Regards,
Tom Ogilvy


"Hari Prasadh" wrote in message
...
Hi,

This is the code which I have written for automatic mapping of data.

If some sample data (10 rows and 2 columns ) is required, please tell me
and
I would be happy to paste that as well in the future post.

Option Explicit
Public basearray() As String
Public arrWords As Variant

Sub readingarrayofuniquewords()

Dim p As Integer
Dim BaseArrLength As Integer

Range("i65536").Select
Selection.End(xlUp).Select
p = Selection.Row - 2

ReDim basearray(p)
For BaseArrLength = 0 To p
basearray(BaseArrLength) = Cells(BaseArrLength + 2, "i")
Next BaseArrLength

End Sub

Sub Upcoding()

Dim R As String
Dim z As Integer
Dim g As Integer
Dim hu As Integer
Dim hg As Integer
Dim msgboxresult As String
Dim tempwithspace As String
Dim tempwithoutspace As String
Dim flag As Integer

Application.ScreenUpdating = False

msgboxresult = MsgBox("Columns B through F will be cleared" & vbLf & "
Press
no if you want to exit out of the macro", vbYesNo, " Warning")
If msgboxresult = vbNo Then Exit Sub

Range("B2:G65536").Select
Selection.ClearContents


Range("A65536").Select
Selection.End(xlUp).Select
R = ActiveCell.Row

Call readingarrayofuniquewords

For z = 2 To R

flag = 0
Splitwords ActiveSheet.Range("A" & z).Value
Range("B" & z).Select
'here put the function for combining elements of array


For hu = UBound(arrWords) To LBound(arrWords) Step -1

For hg = hu To UBound(arrWords) Step 1

If ActiveCell.Column 7 Then
flag = 1
Exit For
End If

tempwithspace = MergingElementsOfArrayWithSpace(arrWords,
hu, hg)
tempwithoutspace =
MergingElementsOfArrayWithoutSpace(arrWords, hu, hg)


For g = LBound(basearray) To UBound(basearray)


If UCase(tempwithspace) = UCase(basearray(g)) Then


ActiveCell.Value = basearray(g)
' u have to put the logic for more than 4 then
exit
loop below
ActiveCell.Offset(0, 1).Range("A1").Select
Exit For

ElseIf UCase(tempwithoutspace) = UCase(basearray(g))
Then

ActiveCell.Value = basearray(g)
' u have to put the logic for more than 4 then
exit
loop below
ActiveCell.Offset(0, 1).Range("A1").Select
Exit For

End If

Next g

Next hg

If flag = 1 Then
Exit For
End If

Next hu

Next z

Application.ScreenUpdating = True

End Sub

Sub Splitwords(sText As String)

Dim x As Integer
Dim arrReplace As Variant

arrReplace = Array(vbTab, ":", ";", ".", ",", "-", Chr(10), Chr(13))
For x = LBound(arrReplace) To UBound(arrReplace)
sText = Replace(sText, arrReplace(x), " ")
Next x

arrWords = Split(Application.WorksheetFunction.Trim(sText), " ")

End Sub

Function MergingElementsOfArrayWithoutSpace(concatarray As Variant, hi As
Integer, ti As Integer) As Variant
Dim tmp As String
Dim f As Integer

tmp = ""

'see whether the range ti - hi to ti is correct or if it is _
to be increased by 1.

For f = ti - hi To ti
tmp = tmp & concatarray(f)
Next f

MergingElementsOfArrayWithoutSpace =
Application.WorksheetFunction.Trim(tmp)

End Function

Function MergingElementsOfArrayWithSpace(concatarray As Variant, hi As
Integer, ti As Integer) As Variant
Dim tmp As String
Dim f As Integer

tmp = ""

'see whether the range ti - hi to ti is correct or if it is _
to be increased by 1.

For f = ti - hi To ti
tmp = tmp & concatarray(f) & " "
Next f

MergingElementsOfArrayWithSpace = Application.WorksheetFunction.Trim(tmp)

End Function


--
Thanks a lot,
Hari
India