PDA

View Full Version : Converting Columns to Rows (365 to 8760)



FinEnergyMan
03-14-2008, 12:10 PM
Hi, I have a work book that has data for every hour of the year. The workbook has a row for each day of the year and a column for every hour. So there are 365 rows and 24 columns. I would like to convert the data into 8760 rows (there are 8760 hours in a year). I will be doing this often and using Transpose will not suffice. I hope someone else has encountered this situation.

I appreciate any help you can offer.

stanleydgrom
03-14-2008, 06:46 PM
FinEnergyMan,

Here you go.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Press and hold down the 'ALT' key, and press the 'F11' key.

Insert a Module in your VBAProject, Microsoft Excel Objects

Copy the below code, and paste it into the Module1.




Option Explicit
Sub TransposeDayHour()
'
' TransposeDayHour Macro
' Macro created 03/14/2008 by Stanley D. Grom, Jr.
'
Dim lngLoopCtr As Long
Application.ScreenUpdating = False
With Range("B365:X365")
.Copy
With Range("A366")
.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End With
.ClearContents
Application.CutCopyMode = False
End With
For lngLoopCtr = 365 To 2 Step -1
Range("A" & lngLoopCtr & ":A" & lngLoopCtr + 22).EntireRow.Insert
With Range("B" & lngLoopCtr - 1 & ":X" & lngLoopCtr - 1)
.Copy
With Range("A" & lngLoopCtr)
.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End With
.ClearContents
Application.CutCopyMode = False
End With
Next lngLoopCtr
Range("A1").Select
Application.ScreenUpdating = True
End Sub




Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


Then run the "TransposeDayHour" macro.


Have a great day,
Stan

Krishna Kumar
03-15-2008, 02:52 AM
Hi,

Try

Sub kTest()
Dim a, i As Long, j As Long, c As Long, w()
a = Range("a2:y366") 'adjust the range
ReDim w(1 To UBound(a, 1) * UBound(a, 2), 1 To 2)
For i = 1 To UBound(a, 1)
For c = 2 To UBound(a, 2)
j = j + 1: w(j, 1) = a(i, 1): w(j, 2) = a(i, c)
Next
Next
If j > 0 Then
Columns("a:c").Insert
With Range("a1")
.Resize(j, 2).Value = w
End With
End If
End Sub

HTH

tstav
03-15-2008, 06:01 PM
One more way to do it.
Each new row contains three columns.
Col1=Date, Col2=Time, Col3=Data

Sub PutCellsIn3Columns()
'-----------------------------------------
'Put cells in a matrix to 3 columns,
'example:
'.............08:00......09:00......10:00
'1/1/2008........a1.........b1.........c1
'2/1/2008........a2.........b2.........c2
'becomes
'1/1/2008...08:00...a1
'1/1/2008...09:00...b1
'1/1/2008...10:00...c1
'2/1/2008...08:00...a2 etc.
'-----------------------------------------
Dim i As Integer, cell As Range
Application.ScreenUpdating = False

'Insert three columns for the new data
Columns("A:C").Insert '<--This I stole from Krishna Kumar

i = 2
'Copy each row
For i = 2 To 366

'This is the cell to copy the data to
Set cell = IIf(cell Is Nothing, _
Cells(Rows.Count, "A").End(xlUp), _
Cells(Rows.Count, "A").End(xlUp).Offset(1, 0))

'Copy the date to 24 cells in column "A"
cell.Resize(24).Value = Cells(i, 4).Value

'Copy the date's data to column "C"
Cells(i, 5).Resize(, 24).Copy
cell.Offset(0, 2).PasteSpecial Transpose:=True
Application.CutCopyMode = False
Next 'i

'Copy the hours to column "B"
Cells(1, 5).Resize(, 24).Copy
Range("B1:B365").PasteSpecial Transpose:=True
Application.CutCopyMode = False

Range("A1").Select
Application.ScreenUpdating = True
End Sub

FinEnergyMan
03-18-2008, 11:25 AM
Thank You, Stanley, Krishna, and Tstav.

I will try the recommended approach.

mdmackillop
03-18-2008, 11:40 AM
The only good reason to change to Excel 2007: 16,384 columns!

Bob Phillips
03-18-2008, 12:46 PM
And unlimited colours

... and better table handling

... and improved pivots

... but so many reason not to.