Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help speeding up my code
Hi guys, I've written some code that finds four letter words that don't
have repeating letters (ex: Foot wouldn't count, two O's) The problem is that it takes a long time to generate them all. Below is my code, if anyone wants to take a look at it and suggest performance tweaks that'd be great. If you have a different method/approach to getting the list of 4 letter words that might be faster I'd like to hear that too. Sub TotalRebuild() GoodToGo = MsgBox("This will rebuild the whole wordlist, and it takes a Long time, over 10 minutes. Are you sure?", vbOKCancel, "Warning, this takes forever") If GoodToGo = vbCancel Then End Application.ScreenUpdating = False 'Application.WindowState = xlMinimized 'Application.Visible = False Range("A:A").ClearContents 'clear column A so we can put the words in For One = 65 To 90 'Set up loop for the first letter o = Chr(One) ' variable o holds first letter For Two = 65 To 90 'set up loop for second letter t = Chr(Two) ' variable t holds second letter For Three = 65 To 90 'set up loop for third letter r = Chr(Three) 'variable r holds third letter For Four = 65 To 90 'set up loop for fourth letter f = Chr(Four) 'variable f holds fourth letter dupe = 0 'reset duplicate variable If o = t Then dupe = 1 ' if letters repeat, then dupe = 1 If o = r Then dupe = 1 If o = f Then dupe = 1 If t = r Then dupe = 1 If t = f Then dupe = 1 If r = f Then dupe = 1 If dupe = 0 Then ' if no leters repeat, then put the letters together word = o & t & r & f If Application.CheckSpelling(word) = True Then ' spellcheck the word rw = rw + 1 'increment what row we put the word in Cells(rw, 1) = word 'put the word in the row rw, column 1 End If End If Next Four Next Three Next Two Next One 'Application.Visible = True 'Application.WindowState = xlMaximized Application.ScreenUpdating = True MsgBox "Done" End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help speeding up my code
The most obvious optimisation is not to go into the inner
loops as soon as you know you've already got a repeated letter. So after For Two = 65 To 90 'set up loop for second letter t = Chr(Two) ' variable t holds second letter add If o < t then with matching End if just before Next Two and after the line r=Chr(Three) add if r<o and r<t (+ matching End if) This hugely cuts down the number of iterations, and in the innermost loop you only need to check that f is not equal to any one of o,t,r. A generally quicker approach is probably to find a word list (see http://wordlist.sourceforge.net/ for some sources) and run through that looking for suitable words. Nick wrote: Hi guys, I've written some code that finds four letter words that don't have repeating letters (ex: Foot wouldn't count, two O's) The problem is that it takes a long time to generate them all. Below is my code, if anyone wants to take a look at it and suggest performance tweaks that'd be great. If you have a different method/approach to getting the list of 4 letter words that might be faster I'd like to hear that too. Sub TotalRebuild() GoodToGo = MsgBox("This will rebuild the whole wordlist, and it takes a Long time, over 10 minutes. Are you sure?", vbOKCancel, "Warning, this takes forever") If GoodToGo = vbCancel Then End Application.ScreenUpdating = False 'Application.WindowState = xlMinimized 'Application.Visible = False Range("A:A").ClearContents 'clear column A so we can put the words in For One = 65 To 90 'Set up loop for the first letter o = Chr(One) ' variable o holds first letter For Two = 65 To 90 'set up loop for second letter t = Chr(Two) ' variable t holds second letter For Three = 65 To 90 'set up loop for third letter r = Chr(Three) 'variable r holds third letter For Four = 65 To 90 'set up loop for fourth letter f = Chr(Four) 'variable f holds fourth letter dupe = 0 'reset duplicate variable If o = t Then dupe = 1 ' if letters repeat, then dupe = 1 If o = r Then dupe = 1 If o = f Then dupe = 1 If t = r Then dupe = 1 If t = f Then dupe = 1 If r = f Then dupe = 1 If dupe = 0 Then ' if no leters repeat, then put the letters together word = o & t & r & f If Application.CheckSpelling(word) = True Then ' spellcheck the word rw = rw + 1 'increment what row we put the word in Cells(rw, 1) = word 'put the word in the row rw, column 1 End If End If Next Four Next Three Next Two Next One 'Application.Visible = True 'Application.WindowState = xlMaximized Application.ScreenUpdating = True MsgBox "Done" End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help speeding up my code
The problem is the line
If Application.CheckSpelling(word) = True Then No amount of tweaking can help if the algorithm involves calling it hundreds of thousands of times (which you would have to do even if you try optimizations like only testing strings that have at least one vowel). Over 99% of the execution time is taken up in evaluating that condition. To see this, replace If Application.CheckSpelling(word) = True Then By (for example) If word Like A*Z Then And your code should take mere seconds to execute (I don't know about *your* code - but I had a similar speed up in my failed attempt to tweak your code - you should see something similar). I don't know what the problem with CheckSpelling is - but it isn't very useful for large collections of words. If you have already run this code once - why not write the results to a text file which you can open when needed? HTH -John Coleman Nick wrote: Hi guys, I've written some code that finds four letter words that don't have repeating letters (ex: Foot wouldn't count, two O's) The problem is that it takes a long time to generate them all. Below is my code, if anyone wants to take a look at it and suggest performance tweaks that'd be great. If you have a different method/approach to getting the list of 4 letter words that might be faster I'd like to hear that too. Sub TotalRebuild() GoodToGo = MsgBox("This will rebuild the whole wordlist, and it takes a Long time, over 10 minutes. Are you sure?", vbOKCancel, "Warning, this takes forever") If GoodToGo = vbCancel Then End Application.ScreenUpdating = False 'Application.WindowState = xlMinimized 'Application.Visible = False Range("A:A").ClearContents 'clear column A so we can put the words in For One = 65 To 90 'Set up loop for the first letter o = Chr(One) ' variable o holds first letter For Two = 65 To 90 'set up loop for second letter t = Chr(Two) ' variable t holds second letter For Three = 65 To 90 'set up loop for third letter r = Chr(Three) 'variable r holds third letter For Four = 65 To 90 'set up loop for fourth letter f = Chr(Four) 'variable f holds fourth letter dupe = 0 'reset duplicate variable If o = t Then dupe = 1 ' if letters repeat, then dupe = 1 If o = r Then dupe = 1 If o = f Then dupe = 1 If t = r Then dupe = 1 If t = f Then dupe = 1 If r = f Then dupe = 1 If dupe = 0 Then ' if no leters repeat, then put the letters together word = o & t & r & f If Application.CheckSpelling(word) = True Then ' spellcheck the word rw = rw + 1 'increment what row we put the word in Cells(rw, 1) = word 'put the word in the row rw, column 1 End If End If Next Four Next Three Next Two Next One 'Application.Visible = True 'Application.WindowState = xlMaximized Application.ScreenUpdating = True MsgBox "Done" End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help speeding up my code
Yes, I knew that the vast majority of the time is spent on the
CheckSpelling(word) part. I had also thought about checking for duplicated letters as the loops played out (as suggested) but hadn't thought hard about how to do that. I can see where that would save some time. Going and getting a word list would have made the exercise moot, and the goal was to generate the list, not just go download it. John, I'm not sure how "If word like A*Z Then" would be similar to spell checking. At some point in the process I have to make sure the word is in the Office dictionary. Do you know a way of cutting out some of the generated "words" prior to checking them against the spellchecker? John Coleman wrote: The problem is the line If Application.CheckSpelling(word) = True Then No amount of tweaking can help if the algorithm involves calling it hundreds of thousands of times (which you would have to do even if you try optimizations like only testing strings that have at least one vowel). Over 99% of the execution time is taken up in evaluating that condition. To see this, replace If Application.CheckSpelling(word) = True Then By (for example) If word Like A*Z Then And your code should take mere seconds to execute (I don't know about *your* code - but I had a similar speed up in my failed attempt to tweak your code - you should see something similar). I don't know what the problem with CheckSpelling is - but it isn't very useful for large collections of words. If you have already run this code once - why not write the results to a text file which you can open when needed? HTH -John Coleman |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help speeding up my code
"If word like "A*Z" " isn;t similar to spell checking - it was just a
random boolean condition designed to *replace* spell checking to confirm that it was in fact spell checking which was the bottle neck. Here is my attempt at a tweak, featuring a rare appearance of a GoTo: Sub MakeWordList() Dim i As Long, j As Long, k As Long, l As Long Dim letters As Variant, word As String Dim R As Range, counter As Long Application.ScreenUpdating = False Range("A:A").ClearContents Set R = Range("A1") For i = 65 To 90 For j = 65 To 90 If j = i Then GoTo continuej For k = 65 To 90 If k = j Or k = i Then GoTo continuek For l = 65 To 90 If l = k Or l = j Or l = i Then GoTo continuel word = Chr(i) & Chr(j) & Chr(k) & Chr(l) If HasVowels(word) Then If Application.CheckSpelling(word) = True Then R.Offset(counter).Value = word counter = counter + 1 End If End If continuel: Next l continuek: Next k continuej: Next j Next i Application.ScreenUpdating = True End Sub Function HasVowels(S As String) As Boolean HasVowels = (S Like "*A*") Or (S Like "*E*") Or _ (S Like "*I*") Or (S Like "*O*") Or _ (S Like "*U*") Or (S Like "*Y*") End Function I was assuming at first that you wanted English words and not abbreviations -but the Excel SpellCheck allows for all sorts of non-word abbreviations like ABMS (for American Board of Medical Specialies). If you want these - then my HasVowels function doesn't really make sense (why include such things only when they have a vowel?) and should be removed. If you don't want such abbreviations- you need something other than the default dictionary. The above code only assembles potential words when they have no repeats - so you only need to look at 26*25*24*23 rather than 26^4. Also - if you are happy throwing away the ones without vowels, it saves an additional 20*19*18*17 calls to Application.CheckSpelling. HTH -John Nick wrote: Yes, I knew that the vast majority of the time is spent on the CheckSpelling(word) part. I had also thought about checking for duplicated letters as the loops played out (as suggested) but hadn't thought hard about how to do that. I can see where that would save some time. Going and getting a word list would have made the exercise moot, and the goal was to generate the list, not just go download it. John, I'm not sure how "If word like A*Z Then" would be similar to spell checking. At some point in the process I have to make sure the word is in the Office dictionary. Do you know a way of cutting out some of the generated "words" prior to checking them against the spellchecker? John Coleman wrote: The problem is the line If Application.CheckSpelling(word) = True Then No amount of tweaking can help if the algorithm involves calling it hundreds of thousands of times (which you would have to do even if you try optimizations like only testing strings that have at least one vowel). Over 99% of the execution time is taken up in evaluating that condition. To see this, replace If Application.CheckSpelling(word) = True Then By (for example) If word Like A*Z Then And your code should take mere seconds to execute (I don't know about *your* code - but I had a similar speed up in my failed attempt to tweak your code - you should see something similar). I don't know what the problem with CheckSpelling is - but it isn't very useful for large collections of words. If you have already run this code once - why not write the results to a text file which you can open when needed? HTH -John Coleman |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help speeding up my code
The idea of checking for a vowel before spellchecking will probably
yield the best performance increase. Thanks. John Coleman wrote: "If word like "A*Z" " isn;t similar to spell checking - it was just a random boolean condition designed to *replace* spell checking to confirm that it was in fact spell checking which was the bottle neck. Here is my attempt at a tweak, featuring a rare appearance of a GoTo: Sub MakeWordList() Dim i As Long, j As Long, k As Long, l As Long Dim letters As Variant, word As String Dim R As Range, counter As Long Application.ScreenUpdating = False Range("A:A").ClearContents Set R = Range("A1") For i = 65 To 90 For j = 65 To 90 If j = i Then GoTo continuej For k = 65 To 90 If k = j Or k = i Then GoTo continuek For l = 65 To 90 If l = k Or l = j Or l = i Then GoTo continuel word = Chr(i) & Chr(j) & Chr(k) & Chr(l) If HasVowels(word) Then If Application.CheckSpelling(word) = True Then R.Offset(counter).Value = word counter = counter + 1 End If End If continuel: Next l continuek: Next k continuej: Next j Next i Application.ScreenUpdating = True End Sub Function HasVowels(S As String) As Boolean HasVowels = (S Like "*A*") Or (S Like "*E*") Or _ (S Like "*I*") Or (S Like "*O*") Or _ (S Like "*U*") Or (S Like "*Y*") End Function I was assuming at first that you wanted English words and not abbreviations -but the Excel SpellCheck allows for all sorts of non-word abbreviations like ABMS (for American Board of Medical Specialies). If you want these - then my HasVowels function doesn't really make sense (why include such things only when they have a vowel?) and should be removed. If you don't want such abbreviations- you need something other than the default dictionary. The above code only assembles potential words when they have no repeats - so you only need to look at 26*25*24*23 rather than 26^4. Also - if you are happy throwing away the ones without vowels, it saves an additional 20*19*18*17 calls to Application.CheckSpelling. HTH -John Nick wrote: Yes, I knew that the vast majority of the time is spent on the CheckSpelling(word) part. I had also thought about checking for duplicated letters as the loops played out (as suggested) but hadn't thought hard about how to do that. I can see where that would save some time. Going and getting a word list would have made the exercise moot, and the goal was to generate the list, not just go download it. John, I'm not sure how "If word like A*Z Then" would be similar to spell checking. At some point in the process I have to make sure the word is in the Office dictionary. Do you know a way of cutting out some of the generated "words" prior to checking them against the spellchecker? John Coleman wrote: The problem is the line If Application.CheckSpelling(word) = True Then No amount of tweaking can help if the algorithm involves calling it hundreds of thousands of times (which you would have to do even if you try optimizations like only testing strings that have at least one vowel). Over 99% of the execution time is taken up in evaluating that condition. To see this, replace If Application.CheckSpelling(word) = True Then By (for example) If word Like A*Z Then And your code should take mere seconds to execute (I don't know about *your* code - but I had a similar speed up in my failed attempt to tweak your code - you should see something similar). I don't know what the problem with CheckSpelling is - but it isn't very useful for large collections of words. If you have already run this code once - why not write the results to a text file which you can open when needed? HTH -John Coleman |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help speeding up my code
Nick wrote: Yes, I knew that the vast majority of the time is spent on the CheckSpelling(word) part. I had also thought about checking for duplicated letters as the loops played out (as suggested) but hadn't thought hard about how to do that. I can see where that would save some time. Going and getting a word list would have made the exercise moot, and the goal was to generate the list, not just go download it. Fair enough, but you're already implicitly using a word list: namely the one used by the Office spell-checker. John, I'm not sure how "If word like A*Z Then" would be similar to spell checking. At some point in the process I have to make sure the word is in the Office dictionary. Do you know a way of cutting out some of the generated "words" prior to checking them against the spellchecker? John Coleman wrote: The problem is the line If Application.CheckSpelling(word) = True Then No amount of tweaking can help if the algorithm involves calling it hundreds of thousands of times (which you would have to do even if you try optimizations like only testing strings that have at least one vowel). Over 99% of the execution time is taken up in evaluating that condition. To see this, replace If Application.CheckSpelling(word) = True Then By (for example) If word Like A*Z Then And your code should take mere seconds to execute (I don't know about *your* code - but I had a similar speed up in my failed attempt to tweak your code - you should see something similar). I don't know what the problem with CheckSpelling is - but it isn't very useful for large collections of words. If you have already run this code once - why not write the results to a text file which you can open when needed? HTH -John Coleman |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help speeding up my code
...and suggest performance tweaks that'd be great.
Hi. Don't know if this idea would be any faster. How about the first loop being 1 to 5, since we know we must have at least one Vowel (v). Hard code all 24 permutations so that we can sequence in our vowel. Again, don't know if this general outline is faster though. For p = 1 To 5 v = Choose(p, "a", "e", "i", "o", "u") For i = 65 To 88 For j = i + 1 To 89 For k = j + 1 To 90 'Test all 24 Permutations here '1 {v, i, j, k} '2 {v, i, k, j} '3...etc '24 {k, j, i, v} -- HTH :) Dana DeLouis Windows XP & Office 2003 "Nick" wrote in message ups.com... Hi guys, I've written some code that finds four letter words that don't have repeating letters (ex: Foot wouldn't count, two O's) The problem is that it takes a long time to generate them all. Below is my code, if anyone wants to take a look at it and suggest performance tweaks that'd be great. If you have a different method/approach to getting the list of 4 letter words that might be faster I'd like to hear that too. Sub TotalRebuild() GoodToGo = MsgBox("This will rebuild the whole wordlist, and it takes a Long time, over 10 minutes. Are you sure?", vbOKCancel, "Warning, this takes forever") If GoodToGo = vbCancel Then End Application.ScreenUpdating = False 'Application.WindowState = xlMinimized 'Application.Visible = False Range("A:A").ClearContents 'clear column A so we can put the words in For One = 65 To 90 'Set up loop for the first letter o = Chr(One) ' variable o holds first letter For Two = 65 To 90 'set up loop for second letter t = Chr(Two) ' variable t holds second letter For Three = 65 To 90 'set up loop for third letter r = Chr(Three) 'variable r holds third letter For Four = 65 To 90 'set up loop for fourth letter f = Chr(Four) 'variable f holds fourth letter dupe = 0 'reset duplicate variable If o = t Then dupe = 1 ' if letters repeat, then dupe = 1 If o = r Then dupe = 1 If o = f Then dupe = 1 If t = r Then dupe = 1 If t = f Then dupe = 1 If r = f Then dupe = 1 If dupe = 0 Then ' if no leters repeat, then put the letters together word = o & t & r & f If Application.CheckSpelling(word) = True Then ' spellcheck the word rw = rw + 1 'increment what row we put the word in Cells(rw, 1) = word 'put the word in the row rw, column 1 End If End If Next Four Next Three Next Two Next One 'Application.Visible = True 'Application.WindowState = xlMaximized Application.ScreenUpdating = True MsgBox "Done" End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
speeding up copy and paste code | Excel Programming | |||
Need help speeding this up | Excel Programming | |||
Help on cleaning / speeding up code | Excel Programming | |||
Speeding Up Code | Excel Programming | |||
Online Resources for Speeding Up Code | Excel Programming |