you will be a god if you know how....

[Guest]

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

 

[Pete_UK]

So, you want it in reverse order? In column C you can fill a sequence
1, 2, 3, 4 etc down to the bottom of your data, highlight columns A to
C and Data | Sort - select column C as the sort key and click on
Descending order, then OK. Then you can delete column C.

Is this what you mean?

Pete

 

[Guest]

Perhaps a pivot table?

Data--Pivot table

See here for info: http://www.cpearson.com/excel/pivots.htm

Dave

 

[Guest]

Copy column A to column C, then copy column B underneath the numbers in
Column C
SORT Column C only
now you have row1 and row2 with parent - child
you can have a formula in column D to check if each or which parent has the
child...

 

[Guest]

This code should work.

Modify these two lines as required
Const FirstRow = "A3:B3"
Const FirstCell = "A3"

Note: A3 has to be the same on both lines

Sub SortSS()


Const FirstRow = "A3:B3"
Const FirstCell = "A3"
Dim abc As Integer



RowOffset1 = 0
Do While (Range(FirstCell). _
Offset(rowoffset:=RowOffset1, columnoffset:=0)) <> 0

RowOffset2 = 0

Do While Range(FirstCell). _
Offset(rowoffset:=RowOffset2, columnoffset:=1) <> ""

If Range(FirstCell).Offset(rowoffset:=RowOffset1,
columnoffset:=0) = _
Range(FirstCell).Offset(rowoffset:=RowOffset2,
columnoffset:=1) Then


Set FirstRange = Range(FirstRow). _
Offset(rowoffset:=RowOffset1, columnoffset:=0)
Set SecondRange = Range(FirstRow). _
Offset(rowoffset:=RowOffset2, columnoffset:=0)


FirstRange.Select
FirstRange.Cut
SecondRange.Select
SecondRange.Insert (xlShiftDown)


End If

RowOffset2 = RowOffset2 + 1

Loop

RowOffset1 = RowOffset1 + 1

Loop


End Sub

 

[Guest]

the program I sent requires the SS number to be numbers. If they are strings
you need to replace this line

from
If Range(FirstCell).Offset(rowoffset:=RowOffset1,
columnoffset:=0) = _
Range(FirstCell).Offset(rowoffset:=RowOffset2,
columnoffset:=1) Then

to
If strcomp(Range(FirstCell).Offset(rowoffset:=RowOffset1, _
columnoffset:=0),Range(FirstCell). _
Offset(rowoffset:=RowOffset2, columnoffset:=1)) = 0 Then

 

[Guest]

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?

 

[Guest]

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.

 

[Guest]

thanks, but is the formula and will this allow for the data to be sorted into
the correct order. I dont think i explained it that well, sorry, but I
showed the final output which is what i want but when the data is extracted
it comes out in a random order and i need to put it back into order

cheers peter

 

[Guest]

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