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
Bookmarks