Making an alphabetical list that fits on one page.

[David]

Hello,

I know how to arrange a column of cells into alphabetical order when
producing a list. However, how can I fit the list across columns so that it
fits on one printable page?

At the moment, I cut the parts of the list that enters onto the next pages
and fit them into the next column. The trouble is that when making new
entries I have to make sure that the list is put back into one column again
so that it will automatically sort them alphabetically. This is a pain!
There must be an easier way.

Thanks for your attention and any advice you can give me.

David

 

[Gord Dibben]

David

How long is your list(how many rows)?

How do you want them laid out on the printed pages?

Snaked like 1-50 in column A and 51-100 in column B and 101 -150 in column C
or snaked in alphabetical order down A then up to top of B then down then up
to top of column C etc.?

How many columns do you want to end up with?

Which macro to post will depend upon some answers to these questions.


Gord Dibben Excel MVP

 

[David]

Thanks for the reply,

Basically I want to compile a list of my DVD collection. Therefore it will
consist of one cell per DVD that will be in column A and will stretch down
to about 300 cells.

Obviously depending on the font size, I would like to be able to fit the
list 4 or 5 columns across and so decreasing the stretch of 300 to just 60
cells going down, but be able to add to the list where it will automatically
fit the new entry in alphabetically.

 

[Gord Dibben]

David

I would have two sheets, one for the entry and one for printing.

After adding new entries to the original sheet, run this macro to copy the
column to a new sheet, sort it then split into a user's choice of number of
columns.

Public Sub SplitToCols()
Dim NUMCOLS As Integer
Dim i As Integer
Dim colsize As Long
On Error GoTo fileerror
Sheets("Original") _ '"Original" will be your sheet name
.Columns(1).Copy Destination:=Worksheets.Add.Range("A1")
With Columns("A:A")
.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
NUMCOLS = InputBox("Choose Final Number of Columns")
colsize = Int((ActiveSheet.UsedRange.Rows.Count + _
(NUMCOLS - 1)) / NUMCOLS)
For i = 2 To NUMCOLS
Cells((i - 1) * colsize + 1, 1).Resize(colsize, 1).Copy Cells(1, i)
Next i
Range(Cells(colsize + 1, 1), Cells(Rows.Count, 1)).Clear
fileerror:
End Sub


Gord