Is a custom sort possible

If you are reading & writing large amounts of
data the best way to do this is via memeory,
Data collections and array variants.
That includes sorting as well ie. read data in an
array variant and sort it in the array before writting it to the sheet.

Better if I email you an example.......

Ivan

Hi BD

I would imagine the problem would lie in the code itself. I'm guessing that you have a lot of "Select", "Selection", "ActiveCell" and Copy and Paste, not to mention those horribly slow Loops!.

You can speed code up a bit with the use of Application.screenupading=false
and
Application.Calculation = xlCalculationManual

Don't forget to set back to xlCalculationAutomatic whenever needed!

I spend a lot of my time stressing to my students that loops should only be used in rare cases and when they are used, the data to Loop through should be narrowed down as much as possible via the use of SpecialCells, AutoFilter, AdvancedFilter etc. As a rule of thumb if the Loop is going to be more than 500 to 1000 I will spend considerable time (if necessary) looking for an alternative, nine times out of ten this pays very good dividends!

Go through your code with a critical eye and use properly dimensioned variables. Do not activate cells or Worksheets, this is not necessary in most cases. Make full use of Excels built in features such as the ones mentioned above. The "Find" Method itself is about 100 times quicker than most loops! A simple (or complex)WorsheetFunction placed within 5000 Rows of a Inserted Column in one go, can be used to return say Text for a wanted entry and a Number for non wanted entries. Then you simply Set a Range Variable to SpecialCells of the Text kind.

I have "Enhanced" many projects in Excel VBA for clients and just by following these rules I'm more often than not able to make the code far more iffecient and quicker.

DaveOzGrid Business Applications

TERRIBLY CURIOUS ABOUT...

:: So far :

THINGS THAT YOU STRING TOGETHER TO CREATE A UNIQUE RECORD

AND THE VLOOKUP FORMULA THAT YOU USE.

I'D APPRECIATE IF YOU WOULD WANT TO TAKE TIME TO MEET MY CURIOSITY.

THANKS.

Aladin

David :

Here's the code that I wrote :
ScreenUpdating is turned off except when to
processing stats - very small area and always on
same sheet

Calculate is set to manual.

The sorting is done via a separte macro and is
called as needed. Attempt to keep the macro code short
and can be used by other macros when needed.

As always thxs for the tips \ suggestions.
BD

Sub All_job_processing()
'
Dim hier_sht As String
Dim hier_key As Variant, hier_title As Variant
Dim total_key As Variant, total_title As Variant
Dim post_here As Variant
Dim resort_trigger As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.Goto Reference:="Main_Home"
Set homesheet = ActiveSheet

On Error GoTo me_bad_all_processing

'Start Timer
Application.Goto Reference:="All_Start_clock"
ActiveCell.FormulaR1C1 = "=NOW()"
With Selection
.NumberFormat = "h:mm:ss AM/PM"
.Copy
.PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False

'Clear out misc triggers
Range("All_Load_cell").ClearContents
Range("All_Job_count").ClearContents
Range("Resort_order").FormulaR1C1 = "Descend"

Range("All_Load_cell") = Application.InputBox(prompt:= _
"Enter the cell reference where data is to be copied {ex BA3}", Type:=2)
post_here = CStr(Range("All_Load_cell"))

Application.Goto Reference:="Process_All"

'Create a value that will trigger the resort @ midpoint
r = ActiveCell.Row
c = ActiveCell.Column
Cells(r, c).Select
Do Until Cells(r, c) = Empty
resort_trigger = resort_trigger + 1
r = r + 1
Loop
Range("All_Job").FormulaR1C1 = resort_trigger

Application.Goto Reference:="Process_All"
r1 = ActiveCell.Row
c1 = ActiveCell.Column
Cells(r1, c1).Select
'Creates a variable so that end of macro - Processor tab
' is reset use total
total_key = ActiveCell.Offset(0, 2)
total_title = ActiveCell.Offset(0, 3)

'Establishes the resort value trigger
resort_trigger = resort_trigger / 2
resort_trigger = resort_trigger + r1

Do Until Cells(r1, c1) = Empty
' A litte code to run stats updating - Always on homesheet
Application.ScreenUpdating = True
Range("All_Job_count") = Range("All_Job_count") + 1
Range("All_Recal_stats").Calculate
Range("Current_Time").Calculate
Application.ScreenUpdating = False

Cells(r1, c1).Select

If ActiveCell.Offset(0, 1) = "X" _
Or ActiveCell.Offset(0, 1) = "x" Then
GoTo skip_job

Else
hier_sht = ActiveCell.Value
hier_key = ActiveCell.Offset(0, 2)
hier_title = ActiveCell.Offset(0, 3)
Application.Goto Reference:="Key"
Range("Key").FormulaR1C1 = hier_key
Range("Title").FormulaR1C1 = hier_title
ActiveSheet.Calculate

Application.Wait Now() + TimeValue("00:00:01") ' Wait a sec

Application.Goto Reference:="All_Data_Copy"
Selection.Copy
Sheets(hier_sht).Select
Range(post_here).Select
Selection.PasteSpecial Paste:=xlValues
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
Range("A1").Select

skip_job:
End If
homesheet.Select
r1 = r1 + 1

If r1 = resort_trigger Then
Call Reorder_sort
End If
Loop

'Stop clock
Application.Goto Reference:="All_Stop_clock"
ActiveCell.FormulaR1C1 = "=NOW()"
With Selection
.NumberFormat = "h:mm:ss AM/PM"
.Copy
.PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False

'Put data back in ascending order & puts total
' back on Processor Tab - Speeds up recal during saving file
Range("Resort_order").ClearContents
Call Reorder_sort
Range("Key").FormulaR1C1 = total_key
Range("Title").FormulaR1C1 = total_title

'Wrap Up
homesheet.Select
Application.Calculation = xlAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlManual
MsgBox ("Done Processing All Data - Check processing time. - Autocal turned off")
Exit Sub

me_bad_all_processing:
MsgBox "All Data processing macro not working"
End Sub

Sub Reorder_sort()

Dim data_range As Variant, flip As Variant
Dim wk_sht As Worksheet
Dim hide_sht As String

Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error GoTo me_bad_sort

' Sheets that hold the data are hidden - prefer no one plays with them
For Each wk_sht In ActiveWorkbook.Worksheets
wk_sht.Visible = True
Next wk_sht

Application.Goto Reference:="Load_Start"
r1 = ActiveCell.Row
c1 = ActiveCell.Column
Cells(r1, c1).Select

'Creates a loop to resort data
Do Until Cells(r1, c1) = Empty
'Selects the tab to be sorted
Cells(r1, c1).Select
data_range = ActiveCell.Offset(0, 1)
hide_sht = ActiveCell.Offset(0, 1).Value

Application.Goto Reference:=data_range
flip = Range("Resort_order")
If flip = "Descend" Then
'Sort in Descending order
Selection.sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, Orientation:=xlTopToBottom
Else
'Sort in Ascending order
Selection.sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, Orientation:=xlTopToBottom
End If

Range("A1").Select
Application.Goto Reference:="Main_Home"
Sheets(hide_sht).Visible = xlHidden
r1 = r1 + 1
Loop

Application.Goto Reference:="Main_Home"
Application.Calculation = xlManual
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
me_bad_sort:
MsgBox "Sort Marco not working"
End Sub

Disregard prior post - Add a comment :Current code : For

David :

Here's the code that I wrote :
ScreenUpdating is turned off except when to
processing stats - very small area and always on
same sheet

Calculate is set to manual.

The sorting is done via a separte macro and is
called as needed. Attempt to keep the macro code short
and can be used by other macros when needed.

As always thxs for the tips \ suggestions.
BD

PS - all loops are about 100 times. Anything more
and I'd shoot myself :)