excel macro for hierarchical sort

[kishjeff]

I'm using excel 2003 on windows 2000.
I have a spreadsheet with 14000 rows on it.
there is a header/title row.
there are many columns.
one column is 'location'.
one column is 'parent'.

I need to sort the data, keeping the header/title row.
parents need to come before children when the sort is finished.

so any rows with parent null or blank would be before other rows.
also, given any row "n" and row "p" where "n.location" = "p.parent",
rown "n" would come before row "p".

Can someone point me to steps to do this.. a macro would probably be best, so I don't change the formatting of the spreadsheet cells.
I'm a bit weak on macros in excel.
thanks alot
Jeff

[cdg10620]

I've done a couple of macros for the engineers at work. You will need to use a for loop looking at each cell in the sheet that has a value, evaluate it, and then run a function. It should be fairly simple. Do some Google searching and let me know if you need any more help.

[kishjeff]

well I've done a fair amount of searching already. I'm hoping for some for loop and row(columnindex) examples.

A classic bubble sort (of sorts),
my pseudo code is
for rows = 1 to numrows - 1
begin
for rows2 = rows to numrows
begin
row1 = spreadsheet(rows)
row2 = spreadsheet(rows2)
if (row1[columnchild] == row2[columnparent])
begin
call function swap(rows, rows2)
end if

end
end

function swap(int rows, int rows2)
begin
-do some swap thingy here
end

[cdg10620]

Here is a link that may help you with your copy and paste function:


Your loop is probably going to be something like this:

Dim objCell As Object
' or you can dim row as object
        
    For Each objCell In ActiveSheet.Columns(6).Cells
    ' or for each row in ActiveSheet.Rows
        'do some logic here
    Next objCell ' or row
End Sub

[kishjeff]

Here is a link that may help you with your copy and paste function:


Your loop is probably going to be something like this:

Dim objCell As Object
' or you can dim row as object
        
    For Each objCell In ActiveSheet.Columns(6).Cells
    ' or for each row in ActiveSheet.Rows
        'do some logic here
    Next objCell ' or row
End Sub

ok. I ended up doing this which I'm sure is probably error prone, and certainly inefficient. Anyone want to give me pointers, I'll take them.
basically this prompts the user for a sheet name, header of the column with key values, header of the column with parent values, and start and end rows to sort.

Function getColIndexByName(ColName)
Dim nColumnCount As Integer
Dim nColx As Integer
Dim sTempString As String
Dim nFoundColx As Integer


nColumnCount = ActiveSheet.Columns.Count
nFoundColx = 0
For nColx = 1 To nColumnCount
sTempString = ActiveSheet.Cells(1, nColx).Value
If (sTempString = ColName) Then
nFoundColx = nColx
End If
Next nColx

getColIndexByName = nFoundColx
End Function

Sub GetUserData()



Dim nStartRow As Integer
Dim nEndRow As Integer
Dim sParentColumn As String
Dim sKeyColumn As String
Dim sWorksheetName As String
Dim nParentColumn As Integer


Dim nKeyColumn As Integer
Dim lastrw As Integer
Dim row As Integer
Dim row2 As Integer

Dim nColx As Integer
Dim sTempString As String
Dim sEndRow As String
Dim sStartRow As String

Dim range1, range2, range3 As Range, temp

Dim aCell1Val, aCell2Val, aCell3Val As String
Dim temprow1, temprow2 As Integer


    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual



sWorksheetName = InputBox("Enter Worksheet Name", "Work Sheet", "location")
sWorksheetName = LTrim(RTrim(sWorksheetName))
If (sWorksheetName = "") Then Exit Sub


sStartRow = InputBox("Enter Start Row To Sort From - 1 is usually the header row so enter at least 2", "start row", 2)
sStartRow = LTrim(RTrim(sStartRow))
If (sStartRow = "") Then Exit Sub
nStartRow = Val(sStartRow)

sEndRow = InputBox("Enter End Row To Sort To", "end row", 5)
sEndRow = LTrim(RTrim(sEndRow))
If (sEndRow = "") Then Exit Sub
nEndRow = Val(sEndRow)

sParentColumn = InputBox("Enter Parent Column Name", "Parent Column", "location")
sParentColumn = LTrim(RTrim(sParentColumn))
If (sParentColumn = "") Then Exit Sub

sKeyColumn = InputBox("Enter Child Column Name which points to a parent column value", "Key Column", "tlmparent")
sKeyColumn = LTrim(RTrim(sKeyColumn))
If (sKeyColumn = "") Then Exit Sub

Worksheets(sWorksheetName).Activate


lastrw = ActiveSheet.UsedRange.Rows.Count

If (nEndRow > lastrw) Then
MsgBox "last row before the last row you entered" + lastrw
Return
End If

nParentColumn = getColIndexByName(sParentColumn)
nKeyColumn = getColIndexByName(sKeyColumn)

If (nParentColumn < 1) Then
MsgBox "Parent Column not found " + sParentColumn
Exit Sub
End If

If (nKeyColumn < 1) Then
MsgBox "Key Column not found " + sKeyColumn
Exit Sub
End If




For row = nStartRow To nEndRow - 1
For row2 = nEndRow To row + 1 Step -1
' if the source column cell in row2 = the parent column cell in row swap them
aCell1Val = Cells(row, nKeyColumn).Value
aCell2Val = Cells(row2, nParentColumn).Value
If (aCell1Val = aCell2Val) Then
     'MsgBox "must swap row " + Str(row) + "(" + aCell1Val + ")" + " and row " + Str(row2) + "(" + aCell2Val + ")"
    Rows(row).Cut
    Rows(row2).Insert Shift:=xlDown
    Rows(row2).Cut
    Rows(row).Insert Shift:=xlDown
     
End If

Next row2
Next row

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub

[cdg10620]

The thing with macros is you just need to make sure that it works correctly and doesn't take a lot of time to run. As long as it meets those requirements I think you should be fine. One thing about being a programmer is that you will probably come back to this code in 6 months or so and be like "Holy cow... What was I thinking." Then you'll revise the code and so on. Just make sure that when you're prompting the user for input you are doing plenty of security/validation checking. Always assume that either A. Your user is an idiot, or B. Your user is malicious.

If you would like someone to help you test this send me a sheet with some data and I'll check it out. Let me know if you need any other help. Have a good one.