sorting text in 2 columns by likeness

D

Denson

I have 2 columns of text with number values associated with them.

Amy 21 Amanda 12
Bill 12 Amy 18
Chris 32 Bill 23
Kathy 8 Chris 12
Kim 15 Curtis 32
Todd 23 Katrhy 21
Todd 5

I need to be able to sort these like this

Amanda 12
Amy 21 Amy 18
Bill 12 Bill 23
Chris 32 Chris 12
Curtis 32
Kathy 8 Kathy 21
Kim 15
Todd 23 Todd 5

Sorting both text xolumns by like text along with number values an
leaving spaces in rows that don't match.

Can this be done in excel?

Thanks
Denson
 
D

Dave Peterson

First, your data got kinda compressed:

Is this what your original would look like:

Amy 21 Amanda 12
Bill 12 Amy 18
Chris 32 Bill 23
Kathy 8 Chris 12
Kim 15 Curtis 32
Todd 23 Kathy 21
Todd 5

And it should look like this when you're done:

Amanda 12
Amy 21 Amy 18
Bill 12 Bill 23
Chris 32 Chris 12
Curtis 32
Kathy 8 Kathy 21
Kim 15
Todd 23 Todd 5


then try this against a copy of your worksheet--it destroys the original data!

Option Explicit
Sub testme01()

Dim Rng1 As Range
Dim Rng2 As Range
Dim wks As Worksheet
Dim iRow As Long

Set wks = Worksheets("sheet1")

With wks
Set Rng1 = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp)).Resize(, 2)
Set Rng2 = .Range("c1", .Cells(.Rows.Count, "C").End(xlUp)).Resize(, 2)

Rng1.Sort key1:=.Range("a1"), order1:=xlAscending, _
header:=xlNo

Rng2.Sort key1:=.Range("c1"), order1:=xlAscending, _
header:=xlNo

iRow = 1
Do
If .Cells(iRow, "A").Value = .Cells(iRow, "C").Value Then
'do nothing, well, check to see if we're done
If Application.CountA(.Cells(iRow, "A").Resize(1, 4)) = 0 Then
'woohoo, we're finished
Exit Do
End If
ElseIf .Cells(iRow, "A").Value < .Cells(iRow, "C").Value Then
'insert in C
.Cells(iRow, "C").Resize(1, 2).Insert shift:=xlDown
Else
'insert in A
.Cells(iRow, "A").Resize(1, 2).Insert shift:=xlDown
End If
iRow = iRow + 1
Loop

End With

End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
 
Top