Right this is happening because I assumed there would be headings in columns A and D so I started the ranges from row 2. And because you only have two words in your correct list, it skipped one (because I assumed D1 would be a heading), meaning that line of code was trying to assign a single value to an array which it doesn't like to do apparently. I should have asked more questions instead of assuming.
If you will be using headings in your real data set then for this test data just add some headings in, otherwise if there will never be any headings you can use this code:
Code:
Sub SpellCheck()
Dim cell As Range, rng As Range
Dim arrD() As Variant, arrM() As Variant
Dim wd As String, correction As String, strD As String
Set rng = Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row)
arrD = Application.Transpose(rng)
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
If InStr(1, strD, "~" & cell.Value & "~", vbTextCompare) Then
cell.Value = StrConv(cell.Value, vbProperCase)
GoTo skipcell
End If
wd = cell.Value
For i = 1 To UBound(arrD)
chrMatch = 0
For j = 1 To Len(wd)
If InStr(1, arrD(i), Mid(wd, j, 1)) Then
chrMatch = chrMatch + 1
End If
Next j
chrMatch = chrMatch / Len(wd)
arrM(i) = chrMatch
Next i
correction = arrD(WorksheetFunction.Match(WorksheetFunction.Max(arrM), arrM, 0))
cell.Offset(0, 1) = correction
skipcell:
Next cell
End Sub
And make sure your list of correct words is at least two words long. I can change the code to accept only one word into the dictionary, but I don't have time right now and I don't think you have a need for it.
I had success with the small set of test data you included, and here is a small set of test data I used:
[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD="align: center"]
A
[/TD]
[TD="width: 64, align: center"]
B
[/TD]
[TD="width: 64, align: center"]
C
[/TD]
[TD="width: 64, align: center"]
D
[/TD]
[/TR]
[TR]
[TD]tyota
[/TD]
[TD="width: 64"]Toyota[/TD]
[TD="width: 64"][/TD]
[TD="width: 64"]Toyota[/TD]
[/TR]
[TR]
[TD="width: 90"]nssan[/TD]
[TD]Nissan
[/TD]
[TD][/TD]
[TD]Marvelous[/TD]
[/TR]
[TR]
[TD="width: 90"]nisann[/TD]
[TD]Nissan[/TD]
[TD][/TD]
[TD]Nissan
[/TD]
[/TR]
[TR]
[TD="width: 90"]nissann[/TD]
[TD]Nissan[/TD]
[TD][/TD]
[TD]Datsun[/TD]
[/TR]
[TR]
[TD="width: 90"]tayoda[/TD]
[TD]Toyota[/TD]
[TD][/TD]
[TD]Mitsubishi[/TD]
[/TR]
[TR]
[TD="width: 90"]tayota[/TD]
[TD]Toyota[/TD]
[TD][/TD]
[TD]Bugatti[/TD]
[/TR]
[TR]
[TD="width: 90"]tyota[/TD]
[TD]Toyota[/TD]
[TD][/TD]
[TD]Lamborghini[/TD]
[/TR]
[TR]
[TD="width: 90"]tayato[/TD]
[TD]Toyota[/TD]
[TD][/TD]
[TD]Ferrari[/TD]
[/TR]
[TR]
[TD="width: 90"]Toyota[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Mitsubfshi[/TD]
[TD="colspan: 2"]Mitsubishi
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Bagetti[/TD]
[TD]Bugatti[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Lumargenni[/TD]
[TD="colspan: 2"]Lamborghini[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Ferrosi[/TD]
[TD="colspan: 2"]Marvelous[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]dutsan[/TD]
[TD]Datsun[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]fereri[/TD]
[TD]Ferrari[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]lambourginni[/TD]
[TD="colspan: 2"]Lamborghini[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]toyoda[/TD]
[TD]Toyota[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Nissan[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Toyota[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Toyota[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Nissan[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Mitsubishi[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
The entries down the bottom had random uppercase letters and they were normalized with a proper format.