ScreenUpdating not working properly

Your sub calls InsertLoopLines which turns screenupdating back on. Change that sub to:

Sub InsertLoopLines()
Dim blnUpdate as Boolean
blnUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
'
' This Sub is important because the For Each Loops that search for matches need a stopping point or else the
' the data is transfered wrong.  This Module may requird som rework.
'
    
Range("33:33,65:65,97:97").Select
Range("A97").Activate
Selection.Insert Shift:=xlDown
    
Application.ScreenUpdating = blnUpdate
    
End Sub