Hi Kevin,

I'm unable to replicate your results. But then again, I'm uncertain about
how to lay out the worksheet. So if you'd like, you may email the workbook
to me at the following email address: mvp <at longhead <dot com.

--
Regards,

Jake Marx
MS MVP - Excel
www.longhead.com

[please keep replies in the newsgroup - email address unmonitored]


Kevin Lyons wrote:
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!