Hi, Cesar thanks for you response. I have tried timing the code below
to see if there is a performance benefit using Cut/Insert EntireRow
against Cutting and Inserting a Range, without reaching a conclusion
about which is faster. I thought that the Range method might be faster
as I assume the memory and/or processing overhead would be less
because one was dealing with a smaller number of cells.
The code forms part of a sort routine that works on non-continuous
data (imagine a crossword puzzle where the white squares hold the
data) All cells are formatted as text. The function IsTime determines
if the data value contains 4 numeric characters and the ReturnTime
function returns that value.
The problem is that if numerous data lines need to be moved or if they
are grossly out of position, the code can take longer to process that
I think it is reasonable for the user to wait. I think I am probably
stuck with this method of sorting the data as I can't see any other
solution hence the need to optimise the code.
Any comments welcome.
Regards
Phil
Sub CrossWorkSort()
'*******************************************************************************
'Purpose: Sort non-continuous Data by Columns
'*******************************************************************************
LastRow = DataRowCount 'Initialise
VarCol = ActiveSheet.Range(Cells(TitleRows + 1, 5), Cells(TitleRows +
1, TitleColumns - 1)).Columns.Count + 4 'Initialise
For cPos = VarCol To 5 Step -1
Set rng = Range(Cells(TitleRows + 1, cPos), Cells(LastRow, cPos))
For i = rng.Rows.Count To 1 Step -1
'-------------------------------------
'SET SOURCE REFERENCE VALUE
If Not IsEmpty(rng(i)) And IsTime(rng(i)) = True Then
Set Source = rng(i)
Else
GoTo Continue
End If
'-------------------------------------
'SET TARGET REFERENCE VALUE
If Cells(Rows.Count, cPos).End(xlUp).Address = Source.Address Then
GoTo Continue
Else
For x = 1 To LastRow
If IsTime(Source.OffSet(x, 0)) = True Then
Set Target = Source.OffSet(x, 0)
Exit For
Else
If Source.OffSet(x, 0).Address = Cells(LastRow,
cPos).Address Then
GoTo Continue
End If
End If
Next
End If
'-------------------------------------
'TEST VALUES IN SAME COLUMN
If Val(ReturnTime(Target)) < Val(ReturnTime(Source)) Then
Target.EntireRow.Cut
Source.EntireRow.Insert Shift:=xlDown
i = i + 2
'------------
GoTo Continue
End If
'-------------------------------------
Continue:
Next
Next
End Sub