I have a little competition with friends, playing Wordle. So I investigated a VBA application to do this.
Firstly, I found a list of Wordle's vocabulary. There were 2309 words. I put those words into column A of a spreadsheet.
So, every time I guessed a word, I put the letters which matched (green or yellow) into cell B1, and the letters which didn't match into cell B2.
Here's what I asked:
Here was the result:I have an excel spreadsheet with a list of words in column 1. Cell b1 has some letters. I want some VBA to produce a list of words from column 1 that contain any of the letters in cell b1, but contain none of the letters in cell b2. Put the results in column C in incremental rows
Code: Select all
Sub FindMatchingWords()
Dim lastRow As Long
Dim i As Long
Dim word As String
Dim letters As String
Dim excludeLetters As String
Dim match As Boolean
lastRow = Range("A" & Rows.Count).End(xlUp).Row
letters = Range("B1").Value
excludeLetters = Range("B2").Value
For i = 1 To lastRow
word = Range("A" & i).Value
match = False
For j = 1 To Len(letters)
If InStr(word, Mid(letters, j, 1)) > 0 And InStr(excludeLetters, Mid(letters, j, 1)) = 0 Then
match = True
Exit For
End If
Next j
If match = True Then
Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = word
End If
Next i
End Sub
Geoff Whitfield
Me: This doesn't work
Chat: I'm sorry that the code is not working as expected. Could you provide more information on the error message or any issues that you are encountering? This will help me troubleshoot and provide a more accurate solution.
Me: it's only looking at the matching letters from two cells in matching positions
Chat: My apologies for the mistake in the previous code. Here's an updated version that should solve the issue:
Code: Select all
Sub FindMatchingWords()
Dim lastRow As Long
Dim i As Long
Dim word As String
Dim letters As String
Dim excludeLetters As String
Dim match As Boolean
lastRow = Range("A" & Rows.Count).End(xlUp).Row
letters = Range("B1").Value
excludeLetters = Range("B2").Value
For i = 1 To lastRow
word = Range("A" & i).Value
match = False
For j = 1 To Len(word)
If InStr(letters, Mid(word, j, 1)) > 0 And InStr(excludeLetters, Mid(word, j, 1)) = 0 Then
match = True
ElseIf InStr(excludeLetters, Mid(word, j, 1)) > 0 Then
match = False
Exit For
End If
Next j
If match = True Then
Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = word
End If
Next i
End Sub
Me: Please change it so that it has to match all the letters in cell b1
chat: Here's an updated version of the code that requires a match for all the letters in cell B1
Code: Select all
Sub FindMatchingWords()
Dim lastRow As Long
Dim i As Long
Dim word As String
Dim letters As String
Dim excludeLetters As String
Dim match As Boolean
lastRow = Range("A" & Rows.Count).End(xlUp).Row
letters = Range("B1").Value
excludeLetters = Range("B2").Value
For i = 1 To lastRow
word = Range("A" & i).Value
match = True
For j = 1 To Len(letters)
If InStr(word, Mid(letters, j, 1)) = 0 Or InStr(excludeLetters, Mid(letters, j, 1)) > 0 Then
match = False
Exit For
End If
Next j
If match = True Then
Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = word
End If
Next i
End Sub
. It should clear the contents of column C before it starts. I can ask it to do that.
. It starts on Row 2 for column C - ideally, it should be Row 1. I'm not fussed
. It lets in a few words that it shouldn't. I haven't debugged this, but it's OK for what I want. I've had a brief exploration of the capabilities and deficiencies of ChatGPT code, and the results are impressive, though not perfect.
I haven't asked it to do positional checks of letters. That's something for the future - in the meantime, I can determine those words manually.
While it may be cheating in one way- in another way, I've had a lot more fun getting the solution in this way than in the conventional way.