Excel Macro Code Crashing

[Halp]

When writing this program I blocked everything out into different subs. It seems like the "Desired To be Removed Text Here" at the bottom is what is causing the crashes. When the code is ran the system will sit for 3-5 min working perfectly and then excel will crash. If you attempt to save the spreadsheet at any time after you have run the code excel will crash. Can anyone please assist? I really need some fresh eyes on this I've exhausted my skills to troubleshoot this problem and I am not to up to date on excel. Thank you!





Sub Whatever()



'After you have added in all the CSV files run macro

'This formats column A the format "Number" and column G and H to the format "11-Jan-11"

Columns(1).NumberFormat = "0"
ActiveSheet.Range("G17", "G2000").NumberFormat = "dd-MMM-yy:"
ActiveSheet.Range("H17", "H2000").NumberFormat = "dd-MMM-yy;"

'This sorts by the status
' "o" Variable for Priority sort
' "s" Variable for Secondary sort
Dim oWorksheet As Worksheet
Set oWorksheet = ActiveWorkbook.Worksheets("Details for Period")
Dim oRangeSort As Range
Dim sRangeSort As Range
Dim oRangeKey As Range
Dim sRangeKey As Range

' one range that includes all colums do sort "A17, K2000"
Set oRangeSort = oWorksheet.Range("A17:K2000")
Set sRangeSort = oWorksheet.Range("A17:K2000")

' Set Columns It will be Sorting by
Set oRangeKey = oWorksheet.Range("I1")
Set sRangeKey = oWorksheet.Range("F1")

' Custom Sort List
Dim sCustomList(1 To 5) As String
sCustomList(1) = "Assigned"
sCustomList(2) = "Work In Progress"
sCustomList(3) = "Pending"
sCustomList(4) = "Resolved"
sCustomList(5) = "Closed"

Application.AddCustomList ListArray:=sCustomList

oWorksheet.Sort.SortFields.Clear
oRangeSort.Sort Key1:=oRangeKey, Order1:=xlAscending, Key2:=sRangeKey, Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

' clean up
Application.DeleteCustomList Application.CustomListCount
Set oWorksheet = Nothing

' Clears all Instances of "Desired To be Removed Text Here" from Column E
Dim i
For i = 1500 To 1 Step -1
If Cells(i, "E").Value = "Desired To be Removed Text Here" Then
Cells(i, "E").EntireRow.Delete
End If
Next
End Sub

[snb]

Sub M_snb()
Application.Addcustomlist array("Assigned","Work In Progress","Pending","Resolved","Closed")

with ThisWorkbook.Worksheets("Details for Period")
.Columns(1).NumberFormat = "0"
.Range("G17:G2000").NumberFormat = "dd-MMM-yy:"
.Range("H17:H2000").NumberFormat = "dd-MMM-yy;"
.Range("A17:K2000").sort .Range("I1"),,.Range("F1"),,,,,xlGuess,application.customlistcount

.columns(5).replace "Desired To be Removed Text Here",""
.columns(5).specialcells(4).entirerow.delete
end with
End Sub


Please use code tags.

[Halp]

SNB, Thank you for the Help with this macro, When I run your adaptation of code it is not crashing which is excellent. However, This is also deleting all text fields in the range between "A1, K16" I Need these boxes to be unaltered because that is where the count for the report I am running is displayed data, is loaded into a previous report spreadsheet. The data that is being altered should be kept in the range of Row 17 and down. If you could make the adjustment to your code to allow for this it would be greatly appreciated. Thank you once again friend, you are a life saver!

[Halp]

I just ran the code and for some reason it is not sorting properly in terms of "
Application.Addcustomlist array("Assigned","Work In Progress","Pending","Resolved","Closed")
"
Also under this there is a secondary search that runs after this one that further sorts it down by ascending order in column F.

[snb]

Sub M_snb()
Application.Addcustomlist array("Assigned","Work In Progress","Pending","Resolved","Closed")

With ThisWorkbook.Worksheets("Details for Period")
.Columns(1).NumberFormat = "0"
.Range("G17:G2000").NumberFormat = "dd-MMM-yy:"
.Range("H17:H2000").NumberFormat = "dd-MMM-yy;"
.Range("A17:K2000").sort .Range("I1"),,.Range("F1"),,,,,0,application.customlistcount +1

.columns(5).replace "Desired To be Removed Text Here",""
.Range("E17:E2000").specialcells(4).entirerow.delete
End With
End Sub

[Halp]

Thanks again for the help snb! There is only 1 small error that's occurring now. There is something going funky with the Sorting of the information. When it is sorted it is not locking the whole row together and moving it. I think its sorting the individual columns. They are sorted accurately however Data is mixing between different columns. We are getting there though! Any Ideas as to why?

[snb]

What code did you use ?

[Halp]

I used your code posted latest in this thread

[Halp]

I Tried to take out your sorting code and put my sorting code in because that part of the program was always working for me. It did the sort properly however when I tried to save it crashed ....




Sub M_snb()
Application.Addcustomlist array("Assigned","Work In Progress","Pending","Resolved","Closed")

With ThisWorkbook.Worksheets("Details for Period")
.Columns(1).NumberFormat = "0"
.Range("G17:G2000").NumberFormat = "dd-MMM-yy:"
.Range("H17:H2000").NumberFormat = "dd-MMM-yy;"

'This sorts by the status
' "o" Variable for Priority sort
' "s" Variable for Secondary sort
Dim oWorksheet As Worksheet
Set oWorksheet = ActiveWorkbook.Worksheets("Details for Period")
Dim oRangeSort As Range
Dim sRangeSort As Range
Dim oRangeKey As Range
Dim sRangeKey As Range

' one range that includes all colums do sort "A17, K2000"
Set oRangeSort = oWorksheet.Range("A17:K2000")
Set sRangeSort = oWorksheet.Range("A17:K2000")

' Set Columns It will be Sorting by
Set oRangeKey = oWorksheet.Range("I1")
Set sRangeKey = oWorksheet.Range("F1")

' Custom Sort List
Dim sCustomList(1 To 5) As String
sCustomList(1) = "Assigned"
sCustomList(2) = "Work In Progress"
sCustomList(3) = "Pending"
sCustomList(4) = "Resolved"
sCustomList(5) = "Closed"

Application.AddCustomList ListArray:=sCustomList

oWorksheet.Sort.SortFields.Clear
oRangeSort.Sort Key1:=oRangeKey, Order1:=xlAscending, Key2:=sRangeKey, Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

' clean up
Application.DeleteCustomList Application.CustomListCount
Set oWorksheet = Nothing

.columns(5).replace "Desired To be Removed Text Here",""
.Range("E17:E2000").specialcells(4).entirerow.delete
End With
End Sub

[snb]

I doubt you used my code unamended.
Please post a sample file.

[Halp]

This was your version of the code that I used unamended. Everything worked properly except the sort. I believe it is sorting the column while leaving the row paired with the cell in the sorted column unaffected by the sort.



Sub M_snb()
Application.Addcustomlist array("Assigned","Work In Progress","Pending","Resolved","Closed")

With ThisWorkbook.Worksheets("Details for Period")
.Columns(1).NumberFormat = "0"
.Range("G17:G2000").NumberFormat = "dd-MMM-yy:"
.Range("H17:H2000").NumberFormat = "dd-MMM-yy;"
.Range("A17:K2000").sort .Range("I1"),,.Range("F1"),,,,,0,application.customlistcount +1

.columns(5).replace "Desired To be Removed Text Here",""
.Range("E17:E2000").specialcells(4).entirerow.delete
End With
End Sub