Movve data from rows to columns

[TJN]

I have the following spreadsheet format:
Entity # Entity Name Acct # 1 Acct #2 Acct #3 Acct #4 Acct #5 ... Acct #28
12345 Entity 12345 100.00 300.00 250.00 200.00 500.00
700.00
23456 Entity 23456 600.00 500.00 700.00 400.00 600.00
900.00
Etc.

There are 28 different accounts plus the entity number and name columns for
a total of 30 columns. There will be upwards of 300 rows representing the
various entities. I need to get the data into a column format similar to the
following in order to sort it against data from another program. I need the
above data to look more like:

Entity # Account # Amount
12345 Acct #1 100.00
12345 Acct # 2 300.00
12345 Acct # 3 250.00
12345 Acct # 4 200.00
12345 Acct # 5 500.00
12345 Acct #28 700.00
23456 Acct # 1 600.00
23456 Acct # 2 500.00
23456 Acct # 3 700.00
23456 Acct # 4 400.00
23456 Acct # 5 600.00
23456 Acct #28 900.00
Etc.

When done there would be approx 8400 rows (28 columns of accts moved into
rows x the approx 300 entities).

Any ideas?

Thanks,

Tim

 

[keepITcool]

search for "Tabular to CSV style layout" in this NG
you'll find some code from me from June 28th.
which should work.

if not let me know.
--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


TJN wrote :

 

[TJN]

I'll give it a try. Thanks, Tim

search for "Tabular to CSV style layout" in this NG
you'll find some code from me from June 28th.
which should work.

if not let me know.
--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


TJN wrote :

 

[STEVE BELL]

Looks like you are going to have to cycle through each row.
Have the input data on Sheet1 and export to Sheet2

[this code not tested and it could be simplified]
' indicates notes

Sub TransferMyData
Dim lrw1 as Long, lrw2 as Long, rng as Range, col1 as Long, col as Long

' build captions
with Worksheets("Sheet2")
.Cells(1,1) = "Entity #"
.Cells(1,2) = "Account #"
.Cells(1,3) = "Amount"
end with

' Find last cell in data, last row, and last col
Set rng = Worksheets("Sheet1").Cells.SpecialCells(xlLastCell)
col = rng.Column
lrw1 = rng.Row

' loop through all cells in data
For rw

 

[STEVE BELL]

Sorry, ran out of time and didn't finish the code.
Will try to come back to it tomorrow
unless some one else is kind enough to step in...

--
steveB

Remove "AYN" from email to respond

Looks like you are going to have to cycle through each row.
Have the input data on Sheet1 and export to Sheet2

[this code not tested and it could be simplified]
' indicates notes

Sub TransferMyData
Dim lrw1 as Long, lrw2 as Long, rng as Range, col1 as Long, col as Long

' build captions
with Worksheets("Sheet2")
.Cells(1,1) = "Entity #"
.Cells(1,2) = "Account #"
.Cells(1,3) = "Amount"
end with

' Find last cell in data, last row, and last col
Set rng = Worksheets("Sheet1").Cells.SpecialCells(xlLastCell)
col = rng.Column
lrw1 = rng.Row

' loop through all cells in data
For rw

--
steveB

Remove "AYN" from email to respond

I have the following spreadsheet format:
Entity # Entity Name Acct # 1 Acct #2 Acct #3 Acct #4 Acct #5 ...
Acct #28
12345 Entity 12345 100.00 300.00 250.00 200.00 500.00
700.00
23456 Entity 23456 600.00 500.00 700.00 400.00 600.00
900.00
Etc.

There are 28 different accounts plus the entity number and name columns
for
a total of 30 columns. There will be upwards of 300 rows representing
the
various entities. I need to get the data into a column format similar to
the
following in order to sort it against data from another program. I need
the
above data to look more like:

Entity # Account # Amount
12345 Acct #1 100.00
12345 Acct # 2 300.00
12345 Acct # 3 250.00
12345 Acct # 4 200.00
12345 Acct # 5 500.00
12345 Acct #28 700.00
23456 Acct # 1 600.00
23456 Acct # 2 500.00
23456 Acct # 3 700.00
23456 Acct # 4 400.00
23456 Acct # 5 600.00
23456 Acct #28 900.00
Etc.

When done there would be approx 8400 rows (28 columns of accts moved into
rows x the approx 300 entities).

Any ideas?

Thanks,

Tim

 

[STEVE BELL]

Sorry for the delay
See if this works for you.
Change Sheet1 & Sheet2 to the name of your worksheets

Sub TransferMyData()
Dim lrw1 As Long, lrw2 As Long, rng As Range, col1 As Long, col As Long

Application.ScreenUpdating = False

' build captions
With Worksheets("Sheet2")
.Cells(1, 1) = "Entity #"
.Cells(1, 2) = "Account #"
.Cells(1, 3) = "Amount"
End With

' Find last last row
lrw1 = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

' loop through all rows in data
For rw = 2 To lrw1
' loop through all columns
For col = 3 To 28
If Worksheets("Sheet1").Cells(rw, col) > 0 Then
lrw2 = Worksheets("Sheet2").Cells(Rows.Count,
"A").End(xlUp).Row
With Worksheets("Sheet2")
.Cells(lrw2, 1) = Worksheets("Sheet1").Cells(rw, 1)
.Cells(lrw2, 2) = Worksheets("Sheet1").Cells(rw, 2)
.Cells(lrw2, 1) = Worksheets("Sheet1").Cells(rw, col)
End With
Next
Next

Application.ScreenUpdating = True
End Sub


--
steveB

Remove "AYN" from email to respond

Sorry, ran out of time and didn't finish the code.
Will try to come back to it tomorrow
unless some one else is kind enough to step in...

--
steveB

Remove "AYN" from email to respond

Looks like you are going to have to cycle through each row.
Have the input data on Sheet1 and export to Sheet2

[this code not tested and it could be simplified]
' indicates notes

Sub TransferMyData
Dim lrw1 as Long, lrw2 as Long, rng as Range, col1 as Long, col as Long

' build captions
with Worksheets("Sheet2")
.Cells(1,1) = "Entity #"
.Cells(1,2) = "Account #"
.Cells(1,3) = "Amount"
end with

' Find last cell in data, last row, and last col
Set rng = Worksheets("Sheet1").Cells.SpecialCells(xlLastCell)
col = rng.Column
lrw1 = rng.Row

' loop through all cells in data
For rw

--
steveB

Remove "AYN" from email to respond

I have the following spreadsheet format:
Entity # Entity Name Acct # 1 Acct #2 Acct #3 Acct #4 Acct #5 ...
Acct #28
12345 Entity 12345 100.00 300.00 250.00 200.00 500.00
700.00
23456 Entity 23456 600.00 500.00 700.00 400.00 600.00
900.00
Etc.

There are 28 different accounts plus the entity number and name columns
for
a total of 30 columns. There will be upwards of 300 rows representing
the
various entities. I need to get the data into a column format similar
to the
following in order to sort it against data from another program. I need
the
above data to look more like:

Entity # Account # Amount
12345 Acct #1 100.00
12345 Acct # 2 300.00
12345 Acct # 3 250.00
12345 Acct # 4 200.00
12345 Acct # 5 500.00
12345 Acct #28 700.00
23456 Acct # 1 600.00
23456 Acct # 2 500.00
23456 Acct # 3 700.00
23456 Acct # 4 400.00
23456 Acct # 5 600.00
23456 Acct #28 900.00
Etc.

When done there would be approx 8400 rows (28 columns of accts moved
into
rows x the approx 300 entities).

Any ideas?

Thanks,

Tim

 

[TJN]

Thank you both. This gets me a huge step closer to getting my project done.

Sorry for the delay
See if this works for you.
Change Sheet1 & Sheet2 to the name of your worksheets

Sub TransferMyData()
Dim lrw1 As Long, lrw2 As Long, rng As Range, col1 As Long, col As Long

Application.ScreenUpdating = False

' build captions
With Worksheets("Sheet2")
.Cells(1, 1) = "Entity #"
.Cells(1, 2) = "Account #"
.Cells(1, 3) = "Amount"
End With

' Find last last row
lrw1 = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

' loop through all rows in data
For rw = 2 To lrw1
' loop through all columns
For col = 3 To 28
If Worksheets("Sheet1").Cells(rw, col) > 0 Then
lrw2 = Worksheets("Sheet2").Cells(Rows.Count,
"A").End(xlUp).Row
With Worksheets("Sheet2")
.Cells(lrw2, 1) = Worksheets("Sheet1").Cells(rw, 1)
.Cells(lrw2, 2) = Worksheets("Sheet1").Cells(rw, 2)
.Cells(lrw2, 1) = Worksheets("Sheet1").Cells(rw, col)
End With
Next
Next

Application.ScreenUpdating = True
End Sub


--
steveB

Remove "AYN" from email to respond

Sorry, ran out of time and didn't finish the code.
Will try to come back to it tomorrow
unless some one else is kind enough to step in...

--
steveB

Remove "AYN" from email to respond

Looks like you are going to have to cycle through each row.
Have the input data on Sheet1 and export to Sheet2

[this code not tested and it could be simplified]
' indicates notes

Sub TransferMyData
Dim lrw1 as Long, lrw2 as Long, rng as Range, col1 as Long, col as Long

' build captions
with Worksheets("Sheet2")
.Cells(1,1) = "Entity #"
.Cells(1,2) = "Account #"
.Cells(1,3) = "Amount"
end with

' Find last cell in data, last row, and last col
Set rng = Worksheets("Sheet1").Cells.SpecialCells(xlLastCell)
col = rng.Column
lrw1 = rng.Row

' loop through all cells in data
For rw

--
steveB

Remove "AYN" from email to respond
I have the following spreadsheet format:
Entity # Entity Name Acct # 1 Acct #2 Acct #3 Acct #4 Acct #5 ...
Acct #28
12345 Entity 12345 100.00 300.00 250.00 200.00 500.00
700.00
23456 Entity 23456 600.00 500.00 700.00 400.00 600.00
900.00
Etc.

There are 28 different accounts plus the entity number and name columns
for
a total of 30 columns. There will be upwards of 300 rows representing
the
various entities. I need to get the data into a column format similar
to the
following in order to sort it against data from another program. I need
the
above data to look more like:

Entity # Account # Amount
12345 Acct #1 100.00
12345 Acct # 2 300.00
12345 Acct # 3 250.00
12345 Acct # 4 200.00
12345 Acct # 5 500.00
12345 Acct #28 700.00
23456 Acct # 1 600.00
23456 Acct # 2 500.00
23456 Acct # 3 700.00
23456 Acct # 4 400.00
23456 Acct # 5 600.00
23456 Acct #28 900.00
Etc.

When done there would be approx 8400 rows (28 columns of accts moved
into
rows x the approx 300 entities).

Any ideas?

Thanks,

Tim