I made a VBA Macro that will be below. I have been using the VBA for the past few days on a file that contains 11 different sheets. The VBA is taking the text in one sheet and trying to find similar text in another sheet. The program requires user input on what row to start the search for both sheets, which sheets to look at, and which columns to look at. I then have a form button to activate the macro as I was just to dumb to figure out how to use the activex button. I can't post the file itself for confidentiality reasons. To put my issue simply, there are certain columns I have been using the program to compare that are significantly "longer" than other columns, it has a lot more text (usually between 200and 800 characters). When I use the program to run this code it works fine for the longer text and it typically works fine for the shorter columns when I compare those. However for some reason 1 specific combination of the shorter comparisons breaks the program every time. For the life of me I can't figure out what is causing the problem. And yes before anyone asks, my coding isn't pretty, but it usually works so ¯\_(ツ)_/¯

What I've tried
Stepping through code: My god it takes so long based on how the program runs but no issues when I do that
Going into VBA and hitting run: Works, issue seems to only occur when I hit the form button
Checking references in tools: Everything seems to be there

Sub cstrmatch_test()
Dim Target1 As Variant
Dim Target2 As Variant
Dim test1 As Variant
Dim test2 As Variant
Dim String1 As String, String2 As String, i As Long, j As Long, noChar As Long
Dim rowcount As Long, rowcount2 As Long
Dim format_error As Integer
Dim arr         As Variant
Dim Similarity_row As Long, Search_row As Long
Dim Similarity_Column As Integer
Dim Match_column As Integer
Dim Similarity_score As Variant
Dim Similarity_start As Integer
Dim Similarity_answer As Integer
Dim Match_start As Integer
Dim answer As Variant
Dim Similarity_sheet As Integer
Dim Match_sheet As Integer
Dim dup_error As Integer
'clear previous results and define variables
Range("D1:H999").Clear
Similarity_sheet = Sheets(1).Cells(6, 1).Value
Sheets(Similarity_sheet).Select
arr = ActiveSheet.Range("A1").CurrentRegion
rowcount = UBound(arr, 1)
Match_sheet = Sheets(1).Cells(6, 2).Value
Sheets(Match_sheet).Select
arr = ActiveSheet.Range("A1").CurrentRegion
rowcount2 = UBound(arr, 1)
Similarity_start = Sheets(1).Cells(2, 1)
Match_start = Sheets(1).Cells(2, 2)
Similarity_Column = Sheets(1).Cells(4, 1)
Match_column = Sheets(1).Cells(4, 2)
dup_error = 0
'cycle the object text that you are trying to find the similarity too
For Similarity_row = Similarity_start To rowcount - 1
Similarity_score = 0
Target1 = (Sheets(Similarity_sheet).Cells.Item(Similarity_row, Similarity_Column).Value)
If Target1 <> "" And dup_error = 0 Then
If Len(Target1) > 1000 Then
    answer = MsgBox("Ahh lawd, baby chil' what is you doin? You finna brick yo computer?", vbYesNo, Title:="Now Hol Up A Damn Minute")
    If answer = vbNo Then
    Exit Sub
    Else
    dup_error = dup_error + 1
    Application.ScreenUpdating = False
    End If
End If
'cycle the text which are are searching through
For Search_row = Match_start To rowcount2 - 1
Target2 = (Sheets(Match_sheet).Cells.Item(Search_row, Match_column).Value)
noChar = 0

'The goal here is to assign the larger String to the variable String1

If Len(Target1) >= Len(Target2) Then
    String1 = Target1
    String2 = Target2
Else
    String1 = Target2
    String2 = Target1
End If

For j = 1 To Len(String2)
    For i = 1 To Len(String1) + 1 - j
    test1 = InStr(String2, Mid(String1, i, j))
    test2 = Mid(String1, i, j)
        If InStr(String2, Mid(String1, i, j)) Then
            noChar = noChar + 1
            Exit For
        End If
    Next i
Next j
'check similarity score against existing score
'if similarity score is higher than what is saved reset similarity score
'save row this score happened on for later
 If (noChar) / (Len(String1)) = 1 Then
    Similarity_score = (noChar) / (Len(String1))
    Similarity_answer = Search_row
    Search_row = rowcount
 ElseIf Similarity_score < (noChar) / (Len(String1)) Then
    Similarity_score = (noChar) / (Len(String1))
    Similarity_answer = Search_row
    Else
    End If
Next Search_row

If Similarity_score > 0.49 Then
Sheets(1).Cells(Similarity_row, 5).Value = Sheets(Similarity_sheet).Cells(Similarity_row, Similarity_Column)
Sheets(1).Cells(Similarity_row, 6).Value = Similarity_score
Sheets(1).Cells(Similarity_row, 7).Value = Sheets(Match_sheet).Cells(Similarity_answer, Match_column) & " Row: " & Similarity_answer
Else
Sheets(1).Cells(Similarity_row, 6).Value = 0
Sheets(1).Cells(Similarity_row, 7).Value = "No Match"
End If

Else
End If

Next Similarity_row
Sheets(1).Select
Range("D1:G3305").WrapText = True
Sheets(1).Rows("1:330").EntireRow.AutoFit
Application.ScreenUpdating = True
End Sub
any ideas on what could be causing the issue?