Having trouble with error handling

[Burrgogi]

The following is a straight forward macro that I wrote. It has a string variable named "Key_Word" and the macro is designed to search for that key_word in 3 different worksheets. The final step is to check if the macro contains the letter Y. If it does not, then I want to display a message box "Today's answer does contain any Y", and then quit. You can jump down to the end where I've got the following comment line:

    ' Condition 3: If the word does NOT contain "Y" anywhere

It mostly works but it keeps tripping up on the very last section of the macro. It does display the message box when the word doesn't contain any Y, but it errors after that and doesn't know what to do. I then inserted a new line: "On Error GoTo 0" to take care of the VBE error, but for some reason I can't figure out, it is still tripping up after the message box.

Just learning some VBA and so my error trapping skills are still newbish. Some help would be appreciated.

Sub Find_Key_Word ()

With UONS
    On Error Resume Next
    lastRow3 = UONS.Range("A" & Rows.Count).End(xlUp).Row
    Set c = UONS.Range("A2:A" & lastRow3).Find(Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    If Not c Is Nothing Then
        c.Value = c.Value & MarkIt
    Else
        MsgBox "Could not find: " & Key_Word & " in the" & UONS & "worksheet!"
    End If
End With

With PARS
    On Error Resume Next
    Set c2 = PARS.Range("A2:A" & lastRow3).Find(Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    If Not c2 Is Nothing Then
        c2.Value = c2.Value & MarkIt
        c2.Offset(, 1).Value = 1
    Else
        MsgBox "Could not find: " & Key_Word & " in the" & PARS & "worksheet!"
    End If
End With

With CSET
    On Error Resume Next
    Set c3 = CSET.Range("A2:A" & lastRow3).Find(Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    If Not c3 Is Nothing Then
        c3.Offset(, 1).Value = 1
    Else
        MsgBox "Could not find: " & Key_Word & " in the" & CSET & "worksheet!"
    End If
End With


' this section processes words that end in Y or contain Y
    ' Condition 1: Check if the word ends with "y"
 
    If Key_Word Like "*y" Then
        ' Search for the word in "Ends with Y" sheet
        Set foundCell = wsEndsWithY.Cells.Find(What:=Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        Set foundCell2 = wsContainsY.Cells.Find(What:=Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not foundCell Is Nothing Then
            'foundCell.Font.Bold = True
            foundCell.Value = foundCell.Value & MarkIt
        End If
        If Not foundCell2 Is Nothing Then
            'foundCell2.Font.Bold = True
            foundCell2.Value = foundCell2.Value & MarkIt
            foundCell2.Offset(, 1).Value = 1
        End If
    End If
 
    ' Condition 2: Check if the word contains "Y" anywhere else
    If InStr(1, Key_Word, "Y", vbTextCompare) > 0 And Not (keyword Like "*y") Then
        ' Search for the word in "Contains letter Y" sheet
        Set foundCell = wsContainsY.Cells.Find(What:=Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        Set foundCell2 = wsContainsY2.Cells.Find(What:=Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not foundCell Is Nothing Then
            'foundCell.Font.Bold = True
            foundCell.Value = foundCell.Value & MarkIt
            foundCell.Offset(, 1).Value = 1
        End If
        If Not foundCell2 Is Nothing Then
            'foundCell2.Font.Bold = True
            foundCell2.Value = foundCell2.Value & MarkIt
            foundCell2.Offset(, 1).Value = 1
        End If
    End If
 
    ' Condition 3: If the word does NOT contain "Y" anywhere
    On Error GoTo 0
    If InStr(1, Key_Word, "Y", vbTextCompare) = 0 Then
        MsgBox "Today's answer does not contain any Y!"
        Exit Sub
    End If

End Sub

To be clear, I am getting a "Code Execution has been interrupted". When I click on 'Debug', the End If line is highlighted. I've tried swapping the order of the "Exit Sub" line and the "End If" line around but it doesn't seem to make any difference.

MsgBox "Today's answer does not contain any Y!"
End If
Exit Sub

 

[Alex Blakenburg]

Error handling is not your issue, in fact your use of On Error Resume Next is hiding major issues with the code.
You would be better off turning on Option Explicit and declaring your variables and working through the issues.

eg.
• What worksheets are intended to be used when doing a find on wsContainsY and wsContainsY2 ?
(provide code name and worksheet name)
• You have the "With" statements but they are not being used
• Your "not found" message box statements all fail. Ignoring the "With" statement they should look like this"

MsgBox "Could not find: " & Key_Word & " in the " & UONS.Name & " worksheet!"
MsgBox "Could not find: " & Key_Word & " in the " & PARS.Name & " worksheet!"
MsgBox "Could not find: " & Key_Word & " in the " & CSET.Name & " worksheet!"

• Key_Word & MarkIt are not assigned a value in the code.

 

[Burrgogi]

Those variables are all assigned values. I purposely cut out major sections of the code for easier reading and for simplicity sake. Here is the entire macro without anything omitted. Sorry for the misunderstanding & omission.

I copy a single word in Notepad (Ctrl + c) then switch to Excel and click on a button which executes the following macro which is designed to find the last empty row in col. B and paste it there. You can see from the macro what the rest of the procedure does.

Sub Run_DailyRoutine
    Dim DTS As Worksheet
    Dim UONS As Worksheet
    Dim PARS As Worksheet
    Dim CSET As Worksheet
    Dim ws As Worksheet
    Dim wsEndsWithY As Worksheet
    Dim wsContainsY As Worksheet
    Dim wsContainsY2 As Worksheet
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim lastRow3 As Long
    Dim tLastRow As Long
    Dim c As Range
    Dim c2 As Range
    Dim c3 As Range
    Dim Key_Word As String
    Dim MarkIt As String
    MarkIt = " - used"
    Set DTS = ThisWorkbook.Sheets("Daily Tracker")
    Set UONS = ThisWorkbook.Sheets("Used or Not")
    Set PARS = ThisWorkbook.Sheets("Parse Sheet")
    Set CSET = ThisWorkbook.Sheets("Complete Set")
    Set wsEndsWithY = ThisWorkbook.Sheets("Y Ending Words")
    Set wsContainsY = ThisWorkbook.Sheets("Words that contain Y")
    Set wsContainsY2 = ThisWorkbook.Sheets("Words that contain Y v2")
    Dim cellValue As String
    Dim numbers() As String
    Dim skippedCount As Integer
    Dim i As Integer
    Dim startNum As Integer
    Dim endNum As Integer
    Dim Found As Boolean
    Dim foundCell As Range
    Dim foundCell2 As Range

With DTS
    lastRow1 = DTS.Range("B" & Rows.Count).End(xlUp).Row + 1
    .Range("B" & lastRow1).Select
    .Paste
    Key_Word = ActiveCell.Value
    ActiveCell.Offset(0, 1).FormulaR1C1 = "=VLOOKUP(RC2,'Complete Set'!R2C1:R[2621]C7,4,FALSE)"
    Range("D" & lastRow1).Select
    cellValue = Range("C" & lastRow1).Value  ' grab the value from the VLOOKUP operation
End With


' Part 1: Add the key_word to the end of the used_words_list table (Column A)
    With ThisWorkbook.Sheets("Used Words Sheet").ListObjects("Used_Words_List")
        'shift from an extra row if list has header
        Dim iHeader As Long
        If .ShowHeaders Then
            iHeader = 1
        Else
            iHeader = 0
        End If
       'find the last row of the list
        tLastRow = .ListRows.Count + 1
       .Range(tLastRow + iHeader, "A").Value = Key_Word
    End With

With UONS
    On Error Resume Next
    lastRow3 = UONS.Range("A" & Rows.Count).End(xlUp).Row
    Set c = UONS.Range("A2:A" & lastRow3).Find(Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    If Not c Is Nothing Then
        c.Value = c.Value & MarkIt
    Else
        MsgBox "Could not find: " & Key_Word & " in the" & UONS & "worksheet!"
    End If
End With

With PARS
    On Error Resume Next
    Set c2 = PARS.Range("A2:A" & lastRow3).Find(Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    If Not c2 Is Nothing Then
        c2.Value = c2.Value & MarkIt
        c2.Offset(, 1).Value = 1
    Else
        MsgBox "Could not find: " & Key_Word & " in the" & PARS & "worksheet!"
    End If
End With

With CSET
    On Error Resume Next
    Set c3 = CSET.Range("A2:A" & lastRow3).Find(Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    If Not c3 Is Nothing Then
        c3.Offset(, 1).Value = 1
    Else
        MsgBox "Could not find: " & Key_Word & " in the" & CSET & "worksheet!"
    End If
End With

    ' If it is a single vowel word, no commas will be present and therefore should go directly to Check_for_Y section
    If InStr(1, cellValue, ",") = 0 Then
        GoTo Check_For_Y
    End If

    ' Split the string by comma
    numbers = Split(cellValue, ",")
 
    ' Check for the number of commas
If Not IsEmpty(numbers) Then
    If UBound(numbers) >= 2 Then
        ' If there are 2 or more commas, search in "triplets"
        Set ws = ThisWorkbook.Sheets("3-vowel Gap Analysis")
        Found = Not ws.Cells.Find(What:=Key_Word) Is Nothing
        If Found Then
            ws.Cells.Find(What:=Key_Word).Value = Key_Word & MarkIt
        End If
    End If
End If
    ' Convert the numbers to integers
    startNum = CInt(numbers(0))
    endNum = CInt(numbers(1))
 
    ' Calculate the number of skipped numbers
    skippedCount = endNum - startNum - 1
 
    ' Handle exceptions
    If startNum >= endNum Then
        MsgBox "The search cannot continue because the start number is greater than or equal to the end number."
        Exit Sub
    ElseIf Abs(endNum - startNum) > 4 Then
        MsgBox "The search cannot continue because the difference between the two numbers is greater than 3."
        Exit Sub
    End If
 
    ' Determine the correct worksheet based on skippedCount
    Select Case skippedCount
        Case 0
            Set ws = ThisWorkbook.Sheets("No Gap")
        Case 1
            Set ws = ThisWorkbook.Sheets("1 Gap")
        Case 2
            Set ws = ThisWorkbook.Sheets("2 Gap")
        Case 3
            Set ws = ThisWorkbook.Sheets("3 Gap")
        Case Else
            MsgBox "The VLOOKUP result returned an unusual number.  The search cannot continue."
            Exit Sub
    End Select

    ' Find and update the variable in the determined worksheet
    Found = Not ws.Cells.Find(What:=Key_Word) Is Nothing
    If Found Then
        ws.Cells.Find(What:=Key_Word).Value = Key_Word & MarkIt
    End If
 
' this section processes words that end in Y or contain Y
    ' Condition 1: Check if the word ends with "y"
Check_For_Y:
 
    If Key_Word Like "*y" Then
        ' Search for the word in "Ends with Y" sheet
        Set foundCell = wsEndsWithY.Cells.Find(What:=Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        Set foundCell2 = wsContainsY.Cells.Find(What:=Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not foundCell Is Nothing Then
            'foundCell.Font.Bold = True
            foundCell.Value = foundCell.Value & MarkIt
        End If
        If Not foundCell2 Is Nothing Then
            'foundCell2.Font.Bold = True
            foundCell2.Value = foundCell2.Value & MarkIt
            foundCell2.Offset(, 1).Value = 1
        End If
    End If
 
    ' Condition 2: Check if the word contains "Y" anywhere else
    If InStr(1, Key_Word, "Y", vbTextCompare) > 0 And Not (keyword Like "*y") Then
        ' Search for the word in "Contains letter Y" sheet
        Set foundCell = wsContainsY.Cells.Find(What:=Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        Set foundCell2 = wsContainsY2.Cells.Find(What:=Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not foundCell Is Nothing Then
            'foundCell.Font.Bold = True
            foundCell.Value = foundCell.Value & MarkIt
            foundCell.Offset(, 1).Value = 1
        End If
        If Not foundCell2 Is Nothing Then
            'foundCell2.Font.Bold = True
            foundCell2.Value = foundCell2.Value & MarkIt
            foundCell2.Offset(, 1).Value = 1
        End If
    End If
 
    ' Condition 3: If the word does NOT contain "Y" anywhere
    On Error GoTo 0
    If InStr(1, Key_Word, "Y", vbTextCompare) = 0 Then
        MsgBox "Today's answer does not contain any Y!"
    End If
    Exit Sub

End Sub

 

[Alex Blakenburg]

Its going to take me a little while to set it up and work through it so I can't do it until later today.
Start with making the changes I have above for the msgbox and also fix the incorrect spelling of Key_Word shown below.

    ' Condition 2: Check if the word contains "Y" anywhere else
    If InStr(1, Key_Word, "Y", vbTextCompare) > 0 And Not (keyword Like "*y") Then

 

[Burrgogi]

Its going to take me a little while to set it up and work through it so I can't do it until later today.
Start with making the changes I have above for the msgbox and also fix the incorrect spelling of Key_Word shown below.

    ' Condition 2: Check if the word contains "Y" anywhere else
    If InStr(1, Key_Word, "Y", vbTextCompare) > 0 And Not (keyword Like "*y") Then

OK, done.

 

[Alex Blakenburg]

Can you enlighten me on what the code below is meant to be doing ?
• There is no Copy but there is a Paste which means it pastes whatever is in the clipboard at that point in time.
• ActiveCell & Select raises red flags. What determines what the initial ActiveCell is ? Can be more explicit in how the code selects which cell it should be using ?

With DTS
    lastRow1 = DTS.Range("B" & Rows.Count).End(xlUp).Row + 1
    .Range("B" & lastRow1).Select
    .Paste
    Key_Word = ActiveCell.Value
    ActiveCell.Offset(0, 1).FormulaR1C1 = "=VLOOKUP(RC2,'Complete Set'!R2C1:R[2621]C7,4,FALSE)"
    Range("D" & lastRow1).Select
    cellValue = Range("C" & lastRow1).Value  ' grab the value from the VLOOKUP operation
End With

 

[Burrgogi]

Can you enlighten me on what the code below is meant to be doing ?
• There is no Copy but there is a Paste which means it pastes whatever is in the clipboard at that point in time.
• ActiveCell & Select raises red flags. What determines what the initial ActiveCell is ? Can be more explicit in how the code selects which cell it should be using ?

With DTS
    lastRow1 = DTS.Range("B" & Rows.Count).End(xlUp).Row + 1
    .Range("B" & lastRow1).Select
    .Paste
    Key_Word = ActiveCell.Value
    ActiveCell.Offset(0, 1).FormulaR1C1 = "=VLOOKUP(RC2,'Complete Set'!R2C1:R[2621]C7,4,FALSE)"
    Range("D" & lastRow1).Select
    cellValue = Range("C" & lastRow1).Value  ' grab the value from the VLOOKUP operation
End With

Yeah so basically what happens is I make some notes in Notepad. Once I'm ready to enter the pertinent information into Excel, I copy a word into Windows memory (Ctrl + C), then switch to Excel, look for the last empty row of col. B (in a worksheet called "Daily Tracker") and then do some other stuff with that word that gets pasted into the last empty row. I got tired of doing that manually so I designed the macro to automate everything I've just described. Whatever gets pasted there (last empty row col. B) is assigned a variable string value "key_word", and you can see from the rest of the macro how that variable gets processed.

At the time that "key_word" gets pasted into col. B, the active cell could be almost anywhere but not quite. I created a simple box on the "Daily Tracker" worksheet and assigned my macro to it so there is no question about which worksheet is active at the time the macro is executed. I did not think it was pertinent to determine which active cell is currently selected before the word gets pasted because the macro is designed to look for the last empty row in column B. It has to move there regardless of which cell is currently selected at the time the macro is launched.

 

[Alex Blakenburg]

I haven't made any major changes just cleaned up the section below a bit. On a copy of your workbook can you try replacing your section of this with the below.
(From With DTS to End With of CSET)
The only other changes are that I changed the "keyword" to "Key_Word" as previously mentioned.
I also removed
- the On Error Goto 0 and
- the Exit Sub (which being at the end doesn't do anything.)

If you can test this and then tell me what it is doing and/or not doing.
If you get any error messages a picture of the message and what line of the code is highlighted when you hit debug.

With DTS
    .Activate
    lastRow1 = .Range("B" & Rows.Count).End(xlUp).Row + 1
    ' Paste from clipboard
    With .Range("B" & lastRow1)
        .PasteSpecial Paste:=xlPasteValues
        Key_Word = .Value                               ' ACTIVECELL ?
        .Offset(0, 1).FormulaR1C1 = "=VLOOKUP(RC2,'Complete Set'!R2C1:R[2621]C7,4,FALSE)"
        cellValue = .Offset(0, 1).Value                 ' grab the value from the VLOOKUP operation
    End With
End With

' Part 1: Add the key_word to the end of the used_words_list table (Column A)
    With ThisWorkbook.Sheets("Used Words Sheet").ListObjects("Used_Words_List")
        'shift from an extra row if list has header
        Dim iHeader As Long
        If .ShowHeaders Then
            iHeader = 1
        Else
            iHeader = 0
        End If
       'find the last row of the list
        tLastRow = .ListRows.Count + 1
       .Range(tLastRow + iHeader, "A").Value = Key_Word
    End With

With UONS
    lastRow3 = .Range("A" & Rows.Count).End(xlUp).Row
    Set c = .Range("A2:A" & lastRow3).Find(Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    If Not c Is Nothing Then
        c.Value = c.Value & MarkIt
    Else
        MsgBox "Could not find: " & Key_Word & " in the " & UONS.Name & " worksheet!"
    End If
End With

With PARS
    lastRow3 = .Range("A" & Rows.Count).End(xlUp).Row
    Set c2 = .Range("A2:A" & lastRow3).Find(Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    If Not c2 Is Nothing Then
        c2.Value = c2.Value & MarkIt
        c2.Offset(, 1).Value = 1
    Else
        MsgBox "Could not find: " & Key_Word & " in the " & PARS.Name & " worksheet!"
    End If
End With

With CSET
    lastRow3 = .Range("A" & Rows.Count).End(xlUp).Row
    Set c3 = .Range("A2:A" & lastRow3).Find(Key_Word, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    If Not c3 Is Nothing Then
        c3.Offset(, 1).Value = 1
    Else
        MsgBox "Could not find: " & Key_Word & " in the " & CSET.Name & " worksheet!"
    End If
End With

 

[Burrgogi]

Error message. Screenshot attached.

at line:
.PasteSpecial Paste:=xlPasteValues

 

[Alex Blakenburg]

Since your original DTS code was working replace my DTS section with yours and rerun it.