I don't think I asked the right question earlier. I have this search box that when I enter the search criteria it will find the row in sheet 2 and return the results in sheet 1 in a list. However, I want that if I enter a misspelled word in the search box and submit a msgbox will appear and ask "Please check your spelling. Is this correct?" and the msgbox will give the user the option of yes, no or cancel. I also want it that if the word is for example "blt" it will return all possible associated words like "belt", "bolt","blot", "but" etc.
Search box code:
Sub SearchParts()
Dim arrParts() As Variant
Range("A7", "B" & Cells(Rows.CountLarge, "B").End(xlDown).Row).Clear
arrParts = FindParts(CStr(Trim(Cells(2, 2))))
Range("A7").Resize(UBound(arrParts, 2), UBound(arrParts)) = _
WorksheetFunction.Transpose(arrParts)
End Sub
Private Function FindParts(PartNumber As String) As Variant
Dim ws As Worksheet
Dim FoundCell As Range
Dim LastCell As Range
Dim rngParts As Range
Dim FirstAddr As String
Dim arrPart() As Variant
Set ws = Worksheets("Data")
Set rngParts = ws.Range("B2:B" & ws.Cells(Rows.CountLarge, "B").End(xlUp).Row)
With rngParts
Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell = rngParts.Find(What:=PartNumber, After:=LastCell, LookAt:=xlPart)
If Not FoundCell Is Nothing Then
FirstAddr = FoundCell.Address
End If
ReDim arrPart(1 To 2, 1 To 1)
Do Until FoundCell Is Nothing
arrPart(1, UBound(arrPart, 2)) = FoundCell.Offset(0, -1)
arrPart(2, UBound(arrPart, 2)) = FoundCell.Value
ReDim Preserve arrPart(1 To 2, 1 To UBound(arrPart, 2) + 1)
Set FoundCell = rngParts.FindNext(After:=FoundCell)
If FoundCell.Address = FirstAddr Then
Exit Do
End If
Loop
FindParts = arrPart
End Function
Spell Check Code:
Option Explicit
Sub SpellCheck()
'
'
Dim SpellCheck As Excel.Range
Set SpellCheck = ActiveSheet.UsedRange
SpellCheck.SpecialCells(xlCellTypeConstants, 22).Select
Selection.CheckSpelling SpellLang:=2057
Set SpellCheck = Nothing
End Sub