CheckSpelling function running slow

[Jonathan Harrison]

I have a fairly simple macro to check the number of misspelled words in a range and output the number of errors to another range. The script works fine, but it takes about 1 second per cell, which becomes a problem when I want to run it on 30,000 records. Is there a more efficient way to do this?

Thanks!

Count the number of errors in a cell:

Public Function countmisspells(cellToCheck As Range) As Long
'Define Excel app so I can access the spell check function of Excel
Dim xlApp As New Excel.Application
'errorCount
Dim errorCount As Long
'slit each word in the cell up
wordHolder = Split(cellToCheck.Value, " ")
'for each word in the array, check the spelling
For Each singleWord In wordHolder
    'if the word is not spelled correctly
    If Not xlApp.CheckSpelling(singleWord) Then
        'increase total misspell count
        errorCount = errorCount + 1
    End If
Next
'return the number of misspells as the result of the function
countmisspells = errorCount
Set xlApp = Nothing
End Function

Loop from user defined range to check multiple cells and output to a user defined range:

For i = 1 To inputCells.Rows.Count
  For j = 1 To inputCells.Columns.Count
      outputCells.Cells(i, j).Value = countmisspells(inputCells.Cells(i, j))
      outputCells.Cells(i, j).ClearFormats
      'MsgBox spellErrors
  Next j
Next i

 

[wigi]

Try reading in the range inputCells as an array, and subsequently loop through the array. Reading from and writing to an Excel sheet is what takes more time (relatively speaking of course).

Why not do .ClearFormats on inputCells instead of doing it on each and every cell separately?

I'm guessing that these 2 simple measures will already have effect on the run time, although honestly I say that I never used CheckSpelling method.

 

[Jonathan Harrison]

Try reading in the range inputCells as an array, and subsequently loop through the array. Reading from and writing to an Excel sheet is what takes more time (relatively speaking of course).

Per your suggestion, I modified my code to put the input range into an array and removed any lines that wrote to cells (for testing only) so that there was minimal reading/writing with the sheet. The new code looks like this:

Public Function countmisspells(cellToCheck) As Long
'Define Excel app so I can access the spell check function of Excel
Dim xlApp As New Excel.Application
'errorCount
Dim errorCount As Long
'slit each word in the cell up
wordHolder = Split(cellToCheck, " ")
'for each word in the array, check the spelling
For Each singleWord In wordHolder
    'if the word is not spelled correctly
    If Not xlApp.CheckSpelling(singleWord) Then
        'increase total misspell count
        errorCount = errorCount + 1
    End If
Next
'return the number of misspells as the result of the function
countmisspells = errorCount
Set xlApp = Nothing
End Function

Sub Button1_Click()
'Start script timer
Dim myTime As Date
myTime = Now
Dim inputCells As Range
Dim inputArray
Set inputCells = Application.InputBox(Prompt:="Select the cells to check", Title:="RANGE TO CHECK", Type:=8)
If inputCells Is Nothing Then Exit Sub
inputArray = inputCells
 
Dim outputCells As Range
Set outputCells = Application.InputBox(Prompt:="Select the output cells", Title:="OUTPUT RANGE", Type:=8)
If outputCells Is Nothing Then Exit Sub
If inputCells.Rows.Count <> outputCells.Rows.Count Or inputCells.Columns.Count <> outputCells.Columns.Count Then
    MsgBox "Input and output ranges must be the same size.", 16
    Exit Sub
End If
 
For i = LBound(inputArray, 1) To UBound(inputArray, 1)
  For j = LBound(inputArray, 2) To UBound(inputArray, 2)
      num = countmisspells(inputArray(i, j))
  Next j
Next i
 
'debug outputs
totalCells = outputCells.Rows.Count * inputCells.Columns.Count
executionTime = (Now - myTime) * 86400
perCell = executionTime / totalCells
MsgBox CStr(totalCells) + " cells were processed over " + CStr(Round(executionTime, 0)) + " seconds or " + CStr(Round(perCell, 2)) + " seconds per cell"
End Sub

Unfortunately, I didn't see a performance gain from this. Did I use the array correctly?

Why not do .ClearFormats on inputCells instead of doing it on each and every cell separately?

I've been using the cell formatting as a way to track the progress of the script so that I don't just stare at the screen wondering how far it is. I've taken this out for now.

I was hopeful that moving to an array would speed things up, but it didn’t seem to make much difference, although I’m sure it will matter when I start doing much larger amounts of data. Is there anything else I can try?

 

[AlphaFrog]

This uses VBA to create a temp MS-Word document and uses MS-Word's spellchecker to count the misspelled words. This should take less than a second.

Function Countmisspells2 counts all the misspellings in a string. Set a reference to the Microsoft Word Object Library under the VBA Tools\ References menu.

Sub Test reads all the text from the selected cells into one string. It uses the function Countmisspells2 and displays the count in a Message Box.

Public Function Countmisspells2(strToCheck As String) As Long

    '********************************************************
    '* add a reference to the Microsoft Word Object library *
    '********************************************************

    Dim wdDoc As Word.Document
    
    Set wdDoc = New Word.Document
    wdDoc.Range.Text = strToCheck
    Countmisspells2 = wdDoc.SpellingErrors.Count
    Set wdDoc = Nothing
    
End Function

Sub Test()
    
    Dim strTemp As String, SpErrsCount As Long
    Dim v As Variant
    Dim i As Long, j As Long
    Dim t As Single
    
    t = Timer
    v = Selection
    For i = 1 To UBound(v, 1)
      For j = 1 To UBound(v, 2)
          strTemp = strTemp & v(i, j) & vbLf
      Next j
    Next i

    SpErrsCount = Countmisspells2(strTemp)
    MsgBox "Spelling errors count: " & SpErrsCount & vbLf & vbLf & "Time: " & Timer - t & " seconds"
    
End Sub

 

[Jonathan Harrison]

AlphaFrog, using the Microsoft Word Object Library is much faster. Great idea. I'm having an issue though, WINWORD.EXE runs in the background and increases it's memory usage with every spellcheck. Something in Countmisspells2 isn't being closed out properly. Any idea what it is?

Thanks again for the help.

 

[AlphaFrog]

Give this a try...

Public Function Countmisspells2(strToCheck As String) As Long

    '********************************************************
    '* add a reference to the Microsoft Word Object library *
    '********************************************************
    
    Dim wdDoc As Word.Document
    
    Set wdDoc = New Word.Document
    wdDoc.Range.Text = strToCheck
    Countmisspells2 = wdDoc.SpellingErrors.Count
    [COLOR="Red"]wdDoc.Close SaveChanges:=wdDoNotSaveChanges[/COLOR]
    Set wdDoc = Nothing
    
End Function

 

[Jonathan Harrison]

That fixed it. I'm down to 0.06 seconds per cell. Right now I'm using ranges instead of arrays but I may give arrays a shot to speed things up even more. For anyone who's interested, here's how my code looks now:

Sub Button1_Click()

'Start script timer
Dim myTime As Date
myTime = Now

Dim inputCells As Range
Set inputCells = Application.InputBox(Prompt:="Select the cells to check", Title:="RANGE TO CHECK", Type:=8)
If inputCells Is Nothing Then Exit Sub

Dim outputCells As Range
Set outputCells = Application.InputBox(Prompt:="Select the output cells", Title:="OUTPUT RANGE", Type:=8)
If outputCells Is Nothing Then Exit Sub

If inputCells.Rows.Count <> outputCells.Rows.Count Or inputCells.Columns.Count <> outputCells.Columns.Count Then
    MsgBox "Input and output ranges must be the same size.", 16
    Exit Sub
End If

Set wdDoc = New Word.Document

'start loop
For i = 1 To inputCells.Rows.Count
  For j = 1 To inputCells.Columns.Count
  
      wdDoc.Range.Text = inputCells.Cells(i, j)
      outputCells.Cells(i, j).Value = wdDoc.SpellingErrors.Count

  Next j
Next i
'end loop

    wdDoc.Close SaveChanges:=wdDoNotSaveChanges
    Set wdDoc = Nothing

'debug outputs
totalCells = outputCells.Rows.Count * inputCells.Columns.Count
executionTime = (Now - myTime) * 86400
perCell = executionTime / totalCells

MsgBox CStr(totalCells) + " cells were processed over " + CStr(Round(executionTime, 0)) + " seconds or " + CStr(Round(perCell, 2)) + " seconds per cell"

End Sub

 

[AlphaFrog]

Your time measurement includes the time the user takes to select the input\output ranges. The actual spellcheck processing time\cell is faster.

 

[Jonathan Harrison]

Your time measurement includes the time the user takes to select the input\output ranges. The actual spellcheck processing time\cell is faster.

Nice catch. Thanks for your help with this.

 

[samurusawyer]

Very informative post thanks for share it.