Jake,

The following is the subroutine I am using:

Here is a quick heads-up as to what I am trying to do. I have four
columns of data: region, courses (single listing for all cities/dates),
cities, dates.

What I am first doing is sorting all data on region, courses, cities,
then dates. I then need to split the two city/date columns into three
sub-columns of two for printing purposes. Any spill-over cities/dates
should align on the left most column, then middle if needed.

As an example, assume the following data:

Region Course City Date
East XML New York Jul 4
East Paris Aug 2
East Rome May 16
East Chicago Jun 27

The results need to be as follows:

Region Course City Date
East XML Chicago Jun 27 Paris Aug 2 Rome May 16
East New York Jul 4

Please let me know if this makes sense.

Thanks for taking a look!

Kevin

--------------------------

Option Explicit
Dim test1, test2, topRange, ceilName, floorName, diffName As Long,
fullRange, startRange, finishRange, actName As Long, menu, menuItem,
borRow, eorRow, i, counter, helpmenu As CommandBarControl, newMenu As
CommandBarPopup, Macros_menu_found As Boolean
Sub sortActNames()
Columns("D:D").Select
borRow = Selection.Find(What:="Final Layout", After:=ActiveCell,
LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Row
eorRow = ActiveCell.SpecialCells(xlLastCell).Row
For i = borRow + 1 To eorRow
If Range("D" & i).Value = "" Then
Range("D" & i).Value = Range("D" & i).Offset(-1, 0)
End If
Next
Selection.EntireColumn.Insert
Range("D" & borRow + 1).FormulaR1C1 = "=RC[-1]&RC[1]"
Range("D" & borRow + 1).Copy
Range("D" & borRow + 2 & ":D" & eorRow).Select
ActiveSheet.Paste
Range("B" & borRow + 1 & ":G" & eorRow).Select
Selection.Sort Key1:=Range("D" & borRow + 1), Order1:=xlAscending,
Key2:=Range("F" & borRow + 1) _
, Order2:=xlAscending, Key3:=Range("G" & borRow + 1),
Order3:=xlAscending, Header:= _
xlNo, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
Columns("D:D").Delete
Columns("D:D").Select
For i = eorRow + 1 To borRow Step -1
If Range("D" & i).Value = Range("D" & i - 1).Value Then
Range("D" & i).Value = ""
End If
Next
topRange = borRow + 1
GoTo dataColumns
dataColumns:
Columns("D:D").Select
For i = topRange To eorRow
' If topRange < "" Then
' startRange = topRange
' finishRange = topRange + 1
' topRange = ""
' End If
If Range("D" & i).Value = "" Then
' MsgBox ("Top range = " & topRange)
If startRange = 0 Then
startRange = topRange
MsgBox ("here-Start range = " & startRange & Chr(13) & _
"Top range = " & topRange)
startRange = i - 1
finishRange = i
End If
Else
If counter < 1 Then
If finishRange startRange Then
MsgBox ("there-Start range = " & startRange & Chr(13) &
_
"Top range = " & topRange)
counter = 1
finishRange = i
End If
End If
End If
' i = startRange
Next
If counter < 1 Then
Range("A1").Select
Exit Sub
End If

'2,5,bottom!!!!!!!!!!!

fullRange = finishRange - startRange
actName = Application.Ceiling(fullRange / 3, 1)
diffName = (fullRange - actName) / 2
ceilName = Application.Ceiling(diffName, 1)
floorName = Application.Floor(diffName, 1)
MsgBox ("Start range = " & startRange & Chr(13) & _
"Finish range = " & finishRange & Chr(13) & _
"Full range = " & fullRange & Chr(13) & _
"Act name = " & actName & Chr(13) & _
"Diff name = " & diffName & Chr(13) & _
"Ceil name = " & ceilName & Chr(13) & _
"Floor name = " & floorName)
If ceilName 0 Then
Range("E" & (startRange + actName) & ":F" & (startRange +
actName + ceilName - 1)).Cut
Range("H" & startRange).Select
ActiveSheet.Paste
End If
If floorName 0 Then
Range("E" & (startRange + actName + ceilName) & ":F" &
(finishRange - 1)).Cut
Range("K" & startRange).Select
ActiveSheet.Paste
End If
Rows(startRange + actName & ":" & finishRange - 1).Delete
topRange = finishRange - (finishRange - 1 - (startRange + actName))
startRange = 0
finishRange = 0
counter = 0
fullRange = 0
actName = 0
diffName = 0
ceilName = 0
floorName = 0
GoTo dataColumns:
End Sub

--------------------------

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!