Autocorrect or Suggest Correction VBA (Misspell)

austinandrei

Board Regular
Joined
Jun 7, 2014
Messages
117
Hi,
Is there a way using VBA to have an auto-correct or suggested correction for misspelled words?
Like below if I have these in Column A:
[TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64"]toyota[/TD]
[/TR]
[TR]
[TD]tayota[/TD]
[/TR]
[TR]
[TD]tyota[/TD]
[/TR]
[TR]
[TD]nissann[/TD]
[/TR]
[TR]
[TD]nisan[/TD]
[/TR]
[TR]
[TD]nssan
nissan[/TD]
[/TR]
</tbody>[/TABLE]
Then the auto-correct or suggested word will be placed in Column B. Above is just an example but not limited to. The VBA can still have items cannot be read but atleast minimize the possibilities of spacing, interchange of letters,etc. There are about hundreds of list not just the 2 words in RED (toyota and nissan).
Also, lets say I have the correct list of items in Column D.
Any vba code that could help will really be appreciated. Thanks a lot!
 
Last edited:
The error is gone now. :)
Its okay and very thankful. :) I can wait for your codes as I know that this will really help a lot in the process.
The only problem now it the spacing issue where when the words in Column A has space inbetween, it will capture the one in the list in Column D with the space. This is just a guess I have for the data I executed.
 
Last edited:
Upvote 0

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Hey sorry I've been busy today. I'm actually getting a bit lost with this now, I think it's because of the small sets of test data. I seem to work something out for a small set of data and then try it with something else and it produces unacceptable results.

Here is what I'm up to so far, it is not satisfactory, but I haven't gotten my head around working with strings of multiple words. You may test it on your real world data but I don't think it will work very well. I'll keep fiddling with it and see if I come up with something better, in the mean time are you comfortable with sharing your real data or is there some sensitivity to it? If you can upload it to something like dropbox then I can access it and work with the full set of data to try and make better adjustments. Sorry this is taking a lot of effort.

Code:
Sub SpellCheck()
    Dim cell As Range, rng As Range
    Dim arrD() As Variant, arrM() As Single
    Dim chrMatch As Single, i As Long
    
    Range("B:C").Clear
    
    Set rng = Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row)
    If rng.Rows.Count = 1 Then
        ReDim arrD(1 To 1)
        arrD(1) = rng
    Else
        arrD = Application.Transpose(rng)
    End If
    
    Set rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    ReDim arrM(1 To UBound(arrD))
    strD$ = "~" & Join(arrD, "~") & "~"
    For Each cell In rng
        ReDim arrM(1 To UBound(arrD))
        If cell.Value = "" Then GoTo skipcell
        If InStr(1, strD, "~" & cell.Value & "~", vbTextCompare) Then
            cell.Value = StrConv(cell.Value, vbProperCase)
            GoTo skipcell
        End If
        wd$ = cell.Value & " "
        wds% = Len(wd) - Len(WorksheetFunction.Substitute(wd, " ", ""))
        lastpos% = 0
        For w% = 1 To wds
            currwd$ = ""
            currwd = Mid(wd, lastpos + 1, InStr(lastpos + 1, wd, " ") - lastpos - 1)
            lastpos = InStr(1, wd, currwd) + Len(currwd)
            For i& = 1 To UBound(arrD)
                twd$ = arrD(i) & " "
                twds% = Len(twd) - Len(WorksheetFunction.Substitute(twd, " ", ""))
                tlastpos% = 0
                For k% = 1 To twds
                    tcurrwd$ = ""
                    tcurrwd = Mid(twd, tlastpos + 1, InStr(tlastpos + 1, twd, " ") - tlastpos - 1)
                    tlastpos = InStr(1, twd, tcurrwd) + Len(tcurrwd)
                    chrMatch! = 0
                    For j% = 1 To Len(currwd)
                        If InStr(1, tcurrwd, Mid(currwd, j, 1), vbTextCompare) Then
                            chrMatch = chrMatch + 1
                        End If
                    Next j
                    chrMatch = (chrMatch / Len(currwd)) * (WorksheetFunction.Min(Len(tcurrwd), chrMatch) / WorksheetFunction.Max(Len(tcurrwd), chrMatch))
                    arrM(i) = arrM(i) + (chrMatch * (w / k))
                Next k
            Next i
        Next w
        correction$ = arrD(WorksheetFunction.Match(WorksheetFunction.Max(arrM), arrM, 0))
        x% = 1
        Do
            x = x + 1
            correction2$ = arrD(WorksheetFunction.Match(WorksheetFunction.Large(arrM, x), arrM, 0))
        Loop Until correction <> correction2
        cell.Offset(0, 1) = correction
        If WorksheetFunction.Max(arrM) - WorksheetFunction.Large(arrM, x) < 0.2 Then cell.Offset(0, 2) = correction2
skipcell:
    Next cell
End Sub
 
Upvote 0
This is really helpful. I am using this code for my recent project. But facing few challenges like if I type "ABCD" which is completely different text from the list. This code is picking something from the list rather than ignoring it. Do we have any work around to it?

Thanks once again
 
Upvote 0

Forum statistics

Threads
1,223,243
Messages
6,170,964
Members
452,371
Latest member
Frana

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top