Hi,

I have 3 types of files that will sort some aspects, in this example by code of product. The problem is that 2-3 seconds after i run the Macro, Excel crashes and i am unable the use the file....

Can anyone explain me, if there is an error in the code that will cause it to crash Excel?

I would attacht the file but it as more than 1 Mb, and i cant...

Sub order()
Dim I As Long
Dim l As Long
Dim snum As Integer
Dim t As Integer
Dim cnum As Range
Dim m As Integer
Dim mm As Integer

Dim m2 As Integer
Dim t2 As Integer
Dim rw As Long
Dim x As Boolean
Dim tt As Integer

rw = 0

m = 0
t = 0
I = 0
l = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "tmp"
Sheets("tmp").Range("A3:BL10000").Clear
For snum = 1 To 8
  Do Until Sheets(snum).Range("C4").Offset(l, 0).Value = "END"
      For I = 0 To 7
      Sheets("tmp").Range("A3").Offset(l, t + I).Value = Sheets(snum).Range("C4").Offset(l, I).Value
      Next
  l = l + 1
  Loop


    ActiveWorkbook.Worksheets("tmp").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("tmp").Sort.SortFields.Add Key:=Range(Range("B3").Offset(0, t), Range("B3").Offset(l - 1, t)) _
        , SortOn:=xlSortOnValues, order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("tmp").Sort
        .SetRange Range(Range("a3").Offset(0, t), Range("A3").Offset(l - 1, t + 7))
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
l = 0
t = t + 8
Next snum




Set cnum = Range("B3").Offset(0, m)
x = True

Do While cnum.Value <> ""
'For rw = 0 To 0

For m = 0 To 56 Step 8
If Not Range("B3").Offset(rw, m) = "" Then
Set cnum = Range("B3").Offset(rw, m)
tt = m
Exit For
Else
Set cnum = Range("B3").Offset(rw, 0)
End If
Next


For mm = 0 To 56 Step 8
If cnum.Value >= Range("B3").Offset(rw, mm).Value And Range("B3").Offset(rw, mm).Value <> "" Then
Set cnum = Range("B3").Offset(rw, mm)
t2 = mm
End If
Next




If x = True Then

For m2 = t2 - 8 To 0 Step -8
If Not Range("B3").Offset(rw, m2).Value = cnum.Value Then
Range(Range("B3").Offset(rw, m2 - 1), Range("B3").Offset(rw, m2 + 6)).Insert shift:=xlDown
Range(Range("B3").Offset(rw, m2 - 1), Range("B3").Offset(rw, m2 + 6)).Clear
End If
Next

For m2 = t2 + 8 To 56 Step 8
If Not Range("B3").Offset(rw, m2).Value = cnum.Value Then
Range(Range("B3").Offset(rw, m2 - 1), Range("B3").Offset(rw, m2 + 6)).Insert shift:=xlDown
Range(Range("B3").Offset(rw, m2 - 1), Range("B3").Offset(rw, m2 + 6)).Clear
End If
Next


End If
rw = rw + 1

Loop
'Next
Sheets("Result").Range("A3:BL10000").Clear
Sheets("tmp").Range("A3:BL10000").Copy
Sheets("Result").Range("A3:BL10000").Value = Sheets("tmp").Range("A3:BL10000").Value
Application.DisplayAlerts = False
Sheets("tmp").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Done"
End Sub