Getting debug error as "code execution has been interrupted"

[Shrutee]

I am just trying to write a macro to text to column and then copy
columns and add similar rows. somtimes, it works and sometimes i ge
debug error. here is my code. can someone please help!!


Sub PerShing()

Sheets("Pershing").Select
Columns("a:a").Select
Selection.TextToColumns Destination:=Range("a1")
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(31, 1), Array(48, 1), Array(57
1), Array(66, 1), _
Array(75, 1), Array(79, 1), Array(92, 1), Array(103, 1)
Array(114, 1), Array(123, 1)), TrailingMinusNumbers:=True
Range("a1").Select
ActiveWindow.SmallScroll Down:=-108

'Delete extras
For Each x In Range("B1:B100")
If x = "SHS" Or x = "ADS" Or x = "COM" Or x = "COM NEW" Or x = "CO
SHS" Or x = "COMMON" Or x = "common stock" Or x = "CL A" Or x = "RE
SHS" Or x = "COM CL A" Or x = "COM USD SHS" Or x = "AMERICAN DEP SHS" O
x = "ADS RP ORD SHS" Or x = "SHS A" Or x = "CL A NEW" Or x = "SHS - A -
Or x = "SHA - A" Or x = "ORD SHS" Then x.Offset(0, 1).Value = "YES" Els
x.Offset(0, 1).Value = "NO"
Next x
Application.ScreenUpdating = False

'Delete blank cells
'# of rows

' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "NO" IN COLUMN C
'========================================================================
Last = Cells(Rows.Count, "C").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "C").Value) = "NO" Then
'Cells(i, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENT
BUT NOT DELETE ROW
Cells(i, "A").EntireRow.Delete
End If
Next i

' Sort by SOLE
Range("1:1").Select
Selection.AutoFilter
Range("A1").Select
Selection.AutoFilter Field:=7, Criteria1:="=*SOLE*", Operator:=xlAnd

' Deletes CALL SOLE
Last = Cells(Rows.Count, "G").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "G").Value) = "CALL SOLE" Then
'Cells(i, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENT
BUT NOT DELETE ROW
Cells(i, "A").EntireRow.Delete
End If
Next i

' Deletes PUT SOLE
Last1 = Cells(Rows.Count, "G").End(xlUp).Row
For j = Last1 To 1 Step -1
If (Cells(j, "G").Value) = "PUT SOLE" Then
'Cells(j, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENT
BUT NOT DELETE ROW
Cells(j, "A").EntireRow.Delete
End If
Next j
'Paste company name and number to final sheet
Columns("a:a").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sheets("Final").Select
Range("a6:a6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Sheets("Pershing").Select
Columns("e:e").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sheets("Final").Select
Range("b6:b6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Sheets("Final").Select
Dim rng As Range, rData As Range
Application.ScreenUpdating = False
Set rData = Range("A6", Range("A6").End(xlDown))
rData.AdvancedFilter xlFilterCopy, copytorange:=Range("Y6")
unique:=True
For Each rng In Range("Y6", Range("Y6").End(xlDown))
rng.Offset(, 1) = WorksheetFunction.SumIf(rData, rng, rData.Offset(
1))
Next rng

Range("Y:Z").Cut Range("A:B")

End Su