Print Column A (287 entries)

  • Thread starter Thread starter Silvym
  • Start date Start date
S

Silvym

Hello
I have 287 entries in Column A, with a width of 39.
My goal is to print this data but not is so many pages.

IE:
Apple
Banana
Cantaloupe
Grapes
Orange
Peaches
Pear
Plums
Watermelon


Would like to print like this:
Apple Banana Cantaloupe
Grapes Orange Peaches
Pear Plum Watermelon

or:
Apple Grapes Pear
Banana Oranges Plum
Cantaloupe Peaches Watermelon

Your help is greatly appreciated.
Thanks
Silv
 
Silvym

Manually............

If your data is an column A starting at Cell A1, then the following
formula, entered in Cell B1 and filled across 8 columns and down 50
rows will produce 8 columns of 50 rows. Any more or less than 400 original
rows, you do the math and make alterations.

=INDIRECT("A"&(ROW()+(COLUMN()-2)*50))

The 2 refers to the column of Cell B1; if you're putting the formula in
a different column, use the appropriate number for that column.

Copy>Paste Special(in place) the results then delete the original column A.

VBA Macro to snake the columns top to bottom...1 to 50 down then 51 to 100
down

Public Sub SplitToCols()
Dim NUMCOLS As Integer
Dim i As Integer
Dim colsize As Long
On Error GoTo fileerror

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

For a different orientation........

''routine to take 1 column of a variable number of rows(including blanks) and
put in a
''choice of number of columns with A1,A2,A3,etc.moved to A1,B1,C1,etc.

Sub ColtoRows()
Dim Rng As Range
Dim i As Long
Dim j As Long
''Dim nocols As Integer
goagain:
Set Rng = Cells(Rows.Count, 1).End(xlUp)
j = 1
On Error Resume Next
nocols = InputBox("Enter Number of Columns Desired")
If nocols = "" Or Not IsNumeric(nocols) Then GoTo tryover
For i = 1 To Rng.Row Step nocols
Cells(j, "A").Resize(1, nocols).Value = _
Application.Transpose(Cells(i, "A").Resize(nocols, 1))
j = j + 1
Next
Range(Cells(j, "A"), Cells(Rng.Row, "A")).ClearContents
Exit Sub
tryover:
Style = vbYesNo
msg = "You Have Cancelled " & Chr(13) _
& "Or Not Entered Criteria" & Chr(13) _
& "Do You Wish To Try Again?"
response = MsgBox(msg, Style)
Set srng = Nothing
If response = vbYes Then GoTo goagain
If response = vbNo Then Exit Sub
On Error GoTo 0
End Sub

Gord Dibben Excel MVP
 
Back
Top