PDA

View Full Version : [SOLVED] Rows to Columns



phendrena
11-28-2008, 02:38 AM
Hello again,

I have a workbook (i have many actually) that currently has it data rather oddly arranged in Rows rather than columns (not my idea, but it's what i've got work with).

It's arranged as such :

Dealer No | Salesperson | Email | User ID | Password

It then repeats the Salesperson/Email/User Id/Password across the row for each and every salesperson at that dealership. Frankly its really badly setup and an utter pain to work with.

Is there an easy way that i can move the data from rows to colums quickly?

Thanks,

(i can't post the workbook due to confidenitality)

Bob Phillips
11-28-2008, 02:51 AM
Then create an example workbook with made up data but showing the structure.

phendrena
11-28-2008, 03:23 AM
Here is an example for you :)

Thanks xld

rbrhodes
11-28-2008, 02:06 PM
Hi ph,

Here's something to get you started. To see the code Right click on the sheet tab and choose 'View Code'. There's a section marked 'User' that could be set up...

david000
11-28-2008, 08:16 PM
Sub test()
Dim c As Range
Dim wk As Worksheet
Dim lc As Long
Dim col As Long
Set wk = ActiveSheet
With wk
lc = Cells(1, Columns.Count).End(xlToLeft).Column
For col = 5 To lc Step 5
Set c = .Range("K1:O1")
c.Copy Destination:=.Range("F" & Rows.Count).End(xlUp).Offset(1, 0)
c.EntireColumn.Delete Shift:=xlToLeft
Next col
End With
End Sub

phendrena
12-01-2008, 01:46 AM
Hi ph,

Here's something to get you started. To see the code Right click on the sheet tab and choose 'View Code'. There's a section marked 'User' that could be set up...

That doesn't seem to work with excel 97, errors : Cut method of Range class failed

and highlights : Range(Cells(GetRow, Counter), Cells(GetRow, Counter + (NumOfCols - 1))).Cut Cells(PutRow, DestCol)





Sub test()
Dim c As Range
Dim wk As Worksheet
Dim lc As Long
Dim col As Long
Set wk = ActiveSheet
With wk
lc = Cells(1, Columns.Count).End(xlToLeft).Column
For col = 5 To lc Step 5
Set c = .Range("K1:O1")
c.Copy Destination:=.Range("F" & Rows.Count).End(xlUp).Offset(1, 0)
c.EntireColumn.Delete Shift:=xlToLeft
Next col
End With
End Sub


Thanks for the above, it kind of works, but doesn't give the results i'm after.

I've added a revised workbook, hopefully it'll make things a little clearer.

Thanks for the replies so far.

david000
12-01-2008, 11:47 PM
Well, never hurts to to try again! :hi:

I had a hard time thinking in terms of columns so I used transpose a bunch of times. The attachment makes more sense, in so far as you can see that I used a new sheet etc, etc.



Sub aaa()
Dim lr As Long, r As Integer, y As Integer, x As Integer
Dim i As Integer, filRng As Range
With Sheet14 'get some data!
.Range("a1:i1").Copy Sheet1.Range("b1")
lr = .cells(.Rows.Count, 1).End(xlUp).Row
For r = lr To 2 Step -1
.Rows(r).EntireRow.Copy
Sheet1.Range("a1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
With Sheet1 'move it around a bit
lr = .cells(.Rows.Count, 1).End(xlUp).Row
For i = lr To 5 Step -5
.Range(.cells(i, 1), .cells(i - 4, 1)).Copy
.Range("F" & .cells(.Rows.Count, "F").End(xlUp).Row).Offset(1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Next i
.Range("a1:a4").Copy
.Range("b" & .cells(.Rows.Count, "b").End(xlUp).Row).Offset(1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
y = .cells(.Rows.Count, 2).End(xlUp).Row
x = .cells(.Rows.Count, 6).End(xlUp).Row
Set filRng = .Range(.cells(y, 2), .cells(x, 5))
'MsgBox filRng.Address
.Range("B" & y).Resize(, 4).AutoFill filRng
End With
Next r
End With
Columns("B:J").AutoFit
Columns(1).Delete
End Sub

phendrena
12-02-2008, 02:49 AM
Cool (Interesting that it's working upwards when moving the data),

It works, but errors after moving data from 10 rows.

Error : AutoFill method of Range class failed.
Highlights : .Range("B" & y).Resize(, 4).AutoFill filRng

Any suggestions on how i can get round this?

Thanks for your help so far.


edit : If it helps, there are 725 rows with approx 3000 users

david000
12-02-2008, 11:02 AM
Any suggestions on how i can get round this?

Hum, I was worried about that. I don't have Excel 97, but you can try a couple things. I have a MsgBox right before that line un-comment out that line and see what it shows. Check the help files for missing necessary data.


otherwise, this works too.

.Range(.cells(y, 2), .cells(x, 5)).Value = .Range("B" & y).Resize(, 4).Value

rbrhodes
12-02-2008, 11:05 AM
Another version:



Option Explicit

Sub DoIt()
Dim GetRow As Long
Dim PutRow As Long
Dim LastRow As Long
Dim LastCol As Long
Dim DestCol As Long
Dim cCounter As Long
Dim rCounter As Long
Dim NumOfCols As Long
'//Begin User
'Row to get data from
GetRow = 2
'Column to put, "E" = 5
DestCol = 5
'Number of Columns at a time
NumOfCols = 5
'Get last row of data to convert
LastRow = Range("E" & Rows.Count).End(xlUp).Row
'//End User
'Speed
Application.ScreenUpdating = False
'Get first destination row
PutRow = LastRow + 1
'Do all rows/cols
For rCounter = GetRow To LastRow
'Get last column of data to convert (this row)
LastCol = Cells(rCounter, Columns.Count).End(xlToLeft).Column
'Check if needed
If LastCol > 9 Then
'Do all Cols
For cCounter = DestCol + NumOfCols To LastCol Step NumOfCols
'Insert a row
Cells(rCounter + 1, 1).EntireRow.Insert
'Cut/Paste block of cells
Range(Cells(rCounter, cCounter).Address, Cells(rCounter, cCounter + (NumOfCols - 1)).Address).Cut Cells(PutRow, DestCol)
'Increment destination row
'PutRow = PutRow + 1
Next cCounter
'Copy&Paste
Range("A" & GetRow & ":E" & GetRow).Copy Range("A2:A" & PutRow - 1)
End If
Next rCounter
'Clear old
Range("J1:IV65536").Clear
'Reset
With Application
.ScreenUpdating = True
.CutCopyMode = False
End With
End Sub

phendrena
12-04-2008, 03:59 AM
Still can't either of the solutions above to work correctly.

David000 - Yours still errors after moving some data, I uncommented the msgbox line and displays the following : $B$2:$E$9 and then keeps popping them up....

rbrhodes - Yours likes to copy the first entry multiple times and doesn't move all the data.

any further suggestions?

Thanks,

david000
12-04-2008, 02:16 PM
:( Well, I'm out of suggestions, and that was the correct address the MsgBox was showing. So, all I can say is, try commenting out these lines.



'Set filRng = .Range(.cells(y, 2), .cells(x, 5))
'MsgBox filRng.Address
'.Range("B" & y).Resize(, 4).AutoFill filRng

with this one


.Range(.cells(y, 2), .cells(x, 5)).Value = .Range("B" & y).Resize(, 4).Value

I want to eliminate the line with AutoFill. I tried this on Excel 2003 and 2007.

I'm sure there's a solution to this!

rbrhodes
12-04-2008, 03:19 PM
Hi,

Borrowed the backwords idea from David0. I've tested this and it worked for me...



Option Explicit
Sub DoIt2It()
Dim LastRow As Long
Dim LastCol As Long
Dim DestCol As Long
Dim cCounter As Long
Dim rCounter As Long
Dim NumOfCols As Long
'Column to put, "E" = 5
DestCol = 5
'Number of Columns at a time
NumOfCols = 5
'Get last row of data to convert
LastRow = Range("E" & Rows.Count).End(xlUp).Row
'Speed
Application.ScreenUpdating = False
'Do all rows/cols (skip header row)
For rCounter = LastRow To 2 Step -1
'Get last column of data to convert (this row)
LastCol = Cells(rCounter, Columns.Count).End(xlToLeft).Column
'Check if needed
If LastCol > 9 Then
'Do all Cols
For cCounter = DestCol + NumOfCols To LastCol Step NumOfCols
'Insert a row
Cells(rCounter + 1, 1).EntireRow.Insert
'Cut/Paste block of cells
Range(Cells(rCounter, cCounter).Address, Cells(rCounter, cCounter + (NumOfCols - 1)).Address).Cut Cells(rCounter + 1, DestCol)
'Copy&Paste
Range("A" & rCounter & ":E" & rCounter).Copy Range("A" & rCounter + 1)
Next cCounter
End If
Next rCounter
'Reset
With Application
.ScreenUpdating = True
.CutCopyMode = False
End With
End Sub

phendrena
03-19-2009, 01:35 AM
Apologies for not getting back quicker on this one as it's been a project on the back burner that i've just come back to.
I'm pleased to report that the above code work exceedingly well.

Many thanks.

rbrhodes
03-25-2009, 07:46 PM
Cheers,

dr