how do I display data in rows?

S

Sam

I want to take an Excel database and display the data in rows across the
sheet. For example, from:

A 1
A 3
A 4
B 2
B 3

I want to produce:

A 1 3 4
B 2 3

with each of these in a separate cell across the row. Is there a way to do
it? Thanks ...
 
S

Sam

Thanks, but I really need an automated way to do it. My tables are much too
big and change frequently.
 
T

Toppers

This VBA module will transpose from Sheet1 to Sheet2 and assumes data starts
in row 1. Change this and sheet names as required.

Code should be inserted into general module

Alt+F11 to open Visual Baic Eitor (VBE)
Right click on w/book in project window and do Insert==>Module
Copy and paste code
Place cursor in code and use F8 to step through code line by line (only for
testing!)

OR

Click green "arrow" button (Run macro) on the standard toolbar in VBE

HTH


Sub Transpose()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrow As Long, row As Long, oRow As Long

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

With ws1
lastrow = .Cells(Rows.Count, "A").End(xlUp).row
row = 1 '<== start row input data
oRow = 1 '<== start row of output data
Set rnga = .Range("a1:a" & lastrow)
Do
n = Application.CountIf(rnga, .Cells(row, "A"))
ws2.Cells(oRow, "A") = .Cells(row, "A")
.Cells(row, "B").Resize(n, 1).Copy
ws2.Cells(oRow, "B").PasteSpecial Paste:=xlPasteAll,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
row = row + n
oRow = oRow + 1
Loop Until row > lastrow
End With
End Sub
 
S

Sam

Thanks very much! This works great!!

Sam

Toppers said:
This VBA module will transpose from Sheet1 to Sheet2 and assumes data starts
in row 1. Change this and sheet names as required.

Code should be inserted into general module

Alt+F11 to open Visual Baic Eitor (VBE)
Right click on w/book in project window and do Insert==>Module
Copy and paste code
Place cursor in code and use F8 to step through code line by line (only for
testing!)

OR

Click green "arrow" button (Run macro) on the standard toolbar in VBE

HTH


Sub Transpose()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrow As Long, row As Long, oRow As Long

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

With ws1
lastrow = .Cells(Rows.Count, "A").End(xlUp).row
row = 1 '<== start row input data
oRow = 1 '<== start row of output data
Set rnga = .Range("a1:a" & lastrow)
Do
n = Application.CountIf(rnga, .Cells(row, "A"))
ws2.Cells(oRow, "A") = .Cells(row, "A")
.Cells(row, "B").Resize(n, 1).Copy
ws2.Cells(oRow, "B").PasteSpecial Paste:=xlPasteAll,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
row = row + n
oRow = oRow + 1
Loop Until row > lastrow
End With
End Sub
Click to expand...
 
Top