you will be a god if you know how....
Pete,
I think that the only way this can be done is by using VBA. So, give the
code below a try. It is assumed that data integrity is the source's
responsibility (i.e., only one child per parent and only one parent per
child.) Otherwise, the program would possibly go into an endless loop. If
there are rows that could not be 'linked' because both parent and child
values does not exist in any other row, then that record will be highlighted
in red.
Lastly, the program assumes that the data is in Sheet1, columns A and B.
Column A has the child value, B has the parent. Data starts from row 1.
Option Explicit
Public Sub DoSort()
Dim lRow As Long
Dim bMoveNext As Boolean
Dim lNewRow As Long
With Sheet1
lRow = 1
While .Range("A" & lRow).Text < ""
bMoveNext = IsMyChildBelowMe(.Range("A" & lRow))
If Not bMoveNext And lRow 1 Then
bMoveNext = IsMyParentAboveMe(.Range("A" & lRow))
End If
If Not bMoveNext Then
'Look for my parent
lNewRow = FindMyParent(.Range("B" & lRow).Text)
If lNewRow 0 Then
'Found my parent. put me below my parent
MoveRow lRow, lNewRow + 1
Else
'Can't find my parent. try looking for my child
lNewRow = FindMyChild(.Range("A" & lRow).Text)
If lNewRow 0 Then
'Found my child. put me above my child
MoveRow lRow, lNewRow
Else
'Can't find my child. Turn me red and move on
.Range("A" & lRow & ":B" & lRow).Interior.Color =
vbRed
lRow = lRow + 1
End If
End If
Else
'I'm already either below my parent or above my child. move on
lRow = lRow + 1
End If
Wend
End With
End Sub
Private Function IsMyChildBelowMe(c As Range) As Boolean
IsMyChildBelowMe = (c.Text = c.Offset(1, 1).Text)
End Function
Private Function IsMyParentAboveMe(c As Range) As Boolean
IsMyParentAboveMe = (c.Offset(0, 1).Text = c.Offset(-1, 0).Text)
End Function
Private Function FindMyParent(strChild As String) As Long
Dim r As Range
Set r = Sheet1.Range("A:A").Find((strChild))
If r Is Nothing Then
FindMyParent = 0
Else
FindMyParent = r.Row
Set r = Nothing
End If
End Function
Private Function FindMyChild(strParent As String) As Long
Dim r As Range
Set r = Sheet1.Range("B:B").Find((strParent))
If r Is Nothing Then
FindMyChild = 0
Else
FindMyChild = r.Row
Set r = Nothing
End If
End Function
Private Sub MoveRow(lRowSource As Long, lRowDest As Long)
Sheet1.Range(lRowSource & ":" & lRowSource).Cut
Sheet1.Range(lRowDest & ":" & lRowDest).Insert xlShiftDown
End Sub
"Little Pete" wrote:
hi
yes, sorry the example is the final output that i want. the data is
extracted in random orders and i have been told this is not possible to
change.
"Vergel Adriano" wrote:
Don't you already have the child record sitting under the parent record in
column 1? Or do you mean that the sample you presented is the desired output
and the rows will not be in that sort order at the start?
Also, is the parent record number always greater than the child record
number? If so, then, you should be able to get what you need by sorting
column 2 in ascending order.
Is there a possibility of 'orphaned' records being in the data set?
"Little Pete" wrote:
no one in the company i work for knows how to sove the below
we have a register of data which use a parent / child relationship. when
you extract the data it is easy to follow if you can put it back into this
parent / child relationship, however it comes out in basically a random
order. i have the following data to go off on each record,
column 1 = child number
column 2 = parent number
you will notice that each records parent number is equal to the child number
of the above record.
what i need to some how do is sort the data so the child record sits under
the parent record.
Column 1 Column 2
000042009500 000000016150
000042150650 000042009500
000043040100 000042150650
000048469200 000043040100
000048348400 000048469200
Cheers Pete
|