Dear all,

I am trying to put together a macro that is deliberately recursive. The purpose of the macro is to compare a list of 4,000 odd supplier names with a larger list of 340,000 where I am looking for partial matches. This macro is designed to go through the list of 4000 names using the =search function in Excel and then determine whether it is a match or not. The macro will run through approx. 50 items before return wit h the error "Run Time Error 28: Out of Stack Space". I have set the Application.EnableEvents = False and this still happens. All assistance welcome.

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+q
'

Do While ActiveCell.Value <> ""
Application.Calculation = xlCalculationManual
ActiveCell.Offset(0, 4).Select
Selection.End(xlDown).Select
Selection.Copy
Selection.End(xlUp).Select
ActiveCell.Offset(0, -4).Select
ActiveSheet.Paste
ActiveCell.Offset(0, 4).Select
Selection.End(xlDown).Select
Application.CutCopyMode = False
Selection.ClearContents
Selection.End(xlUp).Select
ActiveCell.Offset(0, -4).Select
ActiveCell.Offset(1, 1).Select
Calculate
Application.Run "Macro3"
Loop


End Sub


Sub Macro2()


Do While ActiveCell.Value <> ""
Application.ScreenUpdating = False
Application.EnableEvents = False
If Selection.Value = "end" Then
ActiveCell.Offset(-1, 0).Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, -1).Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Run "Macro1"
Else

End If
If Selection.Value > 0 Then
ActiveCell.Offset(0, -1).Select
Selection.Copy
ActiveCell.Offset(0, -1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(1, 1).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Loop

End Sub

Sub Macro3()

Selection.End(xlDown).Select
If Selection.Value = 0 Then
Selection.End(xlUp).Select
ActiveCell.Offset(0, -1).Select
Application.Run "Macro1"
Else
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Application.Run "Macro2"
End If

End Sub