PDA

View Full Version : Solved: Sort Help VBA



gimli
06-21-2011, 05:58 AM
Hello,

Im having trouble with some sort code and could use some help. The following code worked ok before I upgraded to 2007. This sub can be called multiple times while the spreadsheet is being used.


Sub Sort()
' ************

Application.ScreenUpdating = False
Dim i As Integer
Columns(11).Insert
For i = 8 To 17
Cells(i, 11) = Abs(Cells(i, 12) - Cells(13, 6))
Next
Range("J8:R17").Sort key1:=Range("K8:K17"), order1:=xlAscending, Header:=xlNo
Columns(11).Delete

' next sort
Dim j As Integer
Columns(14).Insert
For j = 8 To 17
Cells(j, 14) = Abs(Cells(j, 15) - Cells(9, 6))
Next
Range("J8:R17").Sort key1:=Range("N8:N17"), order1:=xlAscending, Header:=xlNo
Columns(14).Delete
Application.ScreenUpdating = True


End Sub


When I upgraded to 2007 the sort seemed buggy. If the sub gets called more than three times during a session it locks up the spread sheet. I searched for solutions and found some code to speed up the worksheet...thinking that may be the problem.


Sub Sort()
' ************

Application.ScreenUpdating = False
Call Speedon
Dim i As Integer
Columns(11).Insert
For i = 8 To 17
Cells(i, 11) = Abs(Cells(i, 12) - Cells(13, 6))
Next
Range("J8:R17").Sort key1:=Range("K8:K17"), order1:=xlAscending, Header:=xlNo
Columns(11).Delete

' next sort
Dim j As Integer
Columns(14).Insert
For j = 8 To 17
Cells(j, 14) = Abs(Cells(j, 15) - Cells(9, 6))
Next
Range("J8:R17").Sort key1:=Range("N8:N17"), order1:=xlAscending, Header:=xlNo
Columns(14).Delete
Call Speedoff
Application.ScreenUpdating = True


End Sub
Sub SpeedOn(Optional StatusBarMsg As String = "Thinking really hard...")
glb_origCalculationMode = Application.Calculation
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.DisplayAlerts = False
.Cursor = xlWait
.StatusBar = StatusBarMsg
.EnableCancelKey = xlErrorHandler
End With
End Sub


'Sets speed back to normal.
Sub SpeedOff()
With Application
.Calculation = glb_origCalculationMode
.EnableEvents = True
.DisplayAlerts = True
.CalculateBeforeSave = True
.Cursor = xlDefault
.StatusBar = False
.EnableCancelKey = xlInterrupt
End With
End Sub

It does prevent the lock ups but now im getting random data overwriting cells in column K. Not sure if this is enough info for ya. Any ideas would be great.
thanks

Dave
06-21-2011, 04:10 PM
Why are you inserting and then deleting columns? Just over write the existing data. You likely need to be much more specific with your coding ie....

Sheets("Sheet1").Cells(j, 14) = Abs(Sheets("Sheet1").Cells(j, 15) _
- Sheets("Sheet1").Cells(9, 6))

HTH.Dave

gimli
06-22-2011, 10:09 AM
Dave,

Yeah I am a noobie for sure. Thanks for pointing me in the right direction. My sort code was a bit fubared. Both my sorts work great now.

thanks for the help :friends:



Sub Sort()

Application.ScreenUpdating = False
Call SpeedOn

' first sort
Range("J8:Q17").Sort key1:=Range("K8:K17"), order1:=xlAscending, Header:=xlNo
'second sort
Dim i As Integer
For i = 8 To 17
Cells(i, 9) = Abs(Cells(i, 14) - Cells(9, 6))
Next

Range("I8:Q17").Sort key1:=Range("I8:I17"), order1:=xlAscending, Header:=xlNo
Sheets("sheet1").Range("I8:I17").ClearContents

Call SpeedOff
Application.ScreenUpdating = True


End Sub
' speeds up
Sub SpeedOn(Optional StatusBarMsg As String = "Thinking really hard...")
glb_origCalculationMode = Application.Calculation
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.DisplayAlerts = False
.Cursor = xlWait
.StatusBar = StatusBarMsg
.EnableCancelKey = xlErrorHandler
End With
End Sub

'Sets speed back to normal.
Sub SpeedOff()
With Application
.Calculation = glb_origCalculationMode
.EnableEvents = True
.DisplayAlerts = True
.CalculateBeforeSave = True
.Cursor = xlDefault
.StatusBar = False
.EnableCancelKey = xlInterrupt
End With
End Sub