Solved: Sorting using range names

[mehart]

I have a spreadsheet with 4 columns, no headers. In the 4 columns there are lines of information that I have given range names. Example: Lines 1-7, columns A,B,C,D are named P901B. I have hundreds of these named ranges. What I want to do is to sort them by range name in ascending order so that the information in each group stays together and in the same format. I would greatly appreciate any help you could give me. Thanks
...........A............................ B.............................. C....................... ....D

1.. PROGRAM # 901
2.. PROGRAM DESCRIPTION : 2x32x2rux.375 THICK .500 VERT/CC .520 HORZ/CC
3.. CUSTOMER : ADC MVJ-3 Jack
4.. CNC 2
5.. TOOL #................. DESCRIPTION.............. TOOL LENGTH...... CUTTER RADIUS OFFSET COMPENSATION
6.. T01.................... 1/8" HS JOBBERS........... .........H01
7.. T02................ M3.5x.95 H03 SLSP BOT TAP........ H02

[lucas]

Please don't start mutliple threads asking the same question.

Duplicate thread deleted.

[mehart]

Sorry, I got confused. First time on this site. I was trying to figure out how to take the second thread off when you replied.

[mbarron]

The following assumes the first row with data is in row 1 and that there are no rows that do not have a name associated.

[VBA]Option Explicit

Sub SortByName()
Dim iCnt As Integer, fRow As Long, i As Long
Dim rngName As Name, cCell As Range, nRows As Integer, nRng As Range

'Add helpers
Cells(1, 1).EntireRow.Insert
For Each cCell In Range("A1:F1")
cCell = "column" & cCell.Column
Next

'add names and row in name to column F & G
For Each rngName In Names
iCnt = Range(rngName.Name).Rows.Count
fRow = Range(rngName.Name).Row
For i = fRow To fRow + iCnt - 1
Cells(i, 5) = rngName.Name
Cells(i, 6) = iCnt
Next
Next

'Sort the columns
Cells(1, 1).CurrentRegion.Sort key1:=Range("E1"), order1:=xlAscending, Header:=xlYes

'delete the names
i = 2
Do Until Cells(i, 5) = ""

On Error Resume Next
If Application.Names(Cells(i, 5).Value).Name <> "" Then
If Err.Number <> 1004 Then
Application.Names(Cells(i, 5).Value).Delete
Else
Err.Clear
End If
End If
i = i + Cells(i, 6).Value
Loop
On Error GoTo 0


'reapply the names
i = 2
Do Until Cells(i, 1) = ""
Range(Cells(i, 1), Cells(i, 4)).Name = Cells(i, 5)
With Range(Cells(i, 5).Value)
.Resize(Cells(i, 6).Value).Name = Cells(i, 5).Value
End With
i = i + Cells(i, 6).Value
Loop


'get rid of helpers
Cells(1, 1).EntireRow.Delete
Cells(1, 5).EntireColumn.Delete
Cells(1, 5).EntireColumn.Delete

End Sub
[/VBA]

[mehart]

Thank you for your help. Really impressive! I only ran into 1 problem, I kept getting a 400 error. I went through & checked everything and finally notice that one range had a scope of workbook, I guess it didn't like that as when I changed that it ran fine. Thanks again. </IMG>