Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
help with transpose-like macro
Im trying to write a vba macro for an excel spreadsheet that will
format cells from this; A B C D 1 rat z1 z2 z3 2 cat x1 x2 x3 3 bat c1 c2 c3 to something like this A B 1 rat z1 2 rat z2 3 rat z3 4 cat x1 5 cat x2 6 cat x3 7 bat c1 8 bat c2 9 bat c3 has anyone encounted a macro which does this or something similar, or if not, has any idea about how to break down the problem into logcial steps. --- Message posted from http://www.ExcelForum.com/ |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
help with transpose-like macro
oh my nicely formatted tables where ruined. if you cant see, they are
supposed to be excel spreadsheets. The first sheet is 4 columns across and 3 rows down while the second sheet is 2 columns across and 9 sheets down --- Message posted from http://www.ExcelForum.com/ |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
help with transpose-like macro
One way:
Assuming the data [below] to be arranged is in Sheet1, A1:D3 A B C D 1 rat z1 z2 z3 2 cat x1 x2 x3 3 bat c1 c2 c3 Name the range B1:D3 as say: Alpha In a new sheet say, Sheet2 ------------------------------- Put in A1: =OFFSET(Sheet1!$A$1,MATCH(B1,INDIRECT(CHOOSE(MOD(R OW()-1,3)+1,"Sheet1!B:B"," Sheet1!C:C","Sheet1!D:D")),0)-1,0) Put in B1: =OFFSET(Alpha,INT((ROW()-1)/COLUMNS(Alpha)),MOD(ROW()-1,COLUMNS(Alpha)),1,1) Select A1:B1, and copy down to B9 -- Rgds Max xl 97 ---------------------------------- Use xdemechanik <atyahoo<dotcom for email ----------------------------------------- "irato " wrote in message ... Im trying to write a vba macro for an excel spreadsheet that will format cells from this; A B C D 1 rat z1 z2 z3 2 cat x1 x2 x3 3 bat c1 c2 c3 to something like this A B 1 rat z1 2 rat z2 3 rat z3 4 cat x1 5 cat x2 6 cat x3 7 bat c1 8 bat c2 9 bat c3 has anyone encounted a macro which does this or something similar, or if not, has any idea about how to break down the problem into logcial steps. --- Message posted from http://www.ExcelForum.com/ |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
help with transpose-like macro
Hi
Try this, entering the address of the range of cells containing your data to be rearrange as 'input range' anf the furst cell of the range to transpose to as output_range: Sub arrange_data() input_range = Range("a1:d3").Address 'range containing data to transpose output_range = Range("a6").Address 'address of first cell for transposed data input_cols = Range(input_range).Columns.Count input_rows = Range(input_range).Rows.Count off_n = 0 For rn = 1 To input_rows For cn = 2 To input_cols txt = Range(input_range).Columns(1).Rows(rn).Value & " " & Range(input_range).Columns(cn).Rows(rn).Value Range(output_range).Offset(off_n, 0).Value = txt off_n = off_n + 1 Next Next End Sub --- Message posted from http://www.ExcelForum.com/ |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
help with transpose-like macro
"Nicky " wrote
txt = Range(input_range).Columns(1).Rows(rn).Value & " " & Range(input_range).Columns(cn).Rows(rn).Value Range(output_range).Offset(off_n, 0).Value = txt Perhaps just a slight amendment for the part above to output into 2 cols, instead of 1 col?: txt1 = Range(input_range).Columns(1).Rows(rn).Value txt2 = Range(input_range).Columns(cn).Rows(rn).Value With Range(output_range) .Offset(off_n, 0).Value = txt1 .Offset(off_n, 1).Value = txt2 End With -- Rgds Max xl 97 ---------------------------------- Use xdemechanik <atyahoo<dotcom for email ----------------------------------------- |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
help with transpose-like macro
irato
Sub colrows() Dim SrcRg As Range Dim DestCell1 As Range Dim RowCounter As Long, ColOffset As Integer Dim CurrCell As Range Application.ScreenUpdating = False Set SrcRg = Selection.Columns(1) Sheets.Add Set DestCell1 = ActiveCell For Each CurrCell In SrcRg.Cells ColOffset = 1 While CurrCell.Offset(0, ColOffset).Value < "" DestCell1.Offset(RowCounter).Value = CurrCell.Value DestCell1.Offset(RowCounter, 1).Value = CurrCell.Offset(0, _ ColOffset).Value RowCounter = RowCounter + 1 ColOffset = ColOffset + 1 Wend Next End Sub Gord Dibben Excel MVP "irato " wrote in message ... Im trying to write a vba macro for an excel spreadsheet that will format cells from this; A B C D 1 rat z1 z2 z3 2 cat x1 x2 x3 3 bat c1 c2 c3 to something like this A B 1 rat z1 2 rat z2 3 rat z3 4 cat x1 5 cat x2 6 cat x3 7 bat c1 8 bat c2 9 bat c3 has anyone encounted a macro which does this or something similar, or if not, has any idea about how to break down the problem into logcial steps. --- Message posted from http://www.ExcelForum.com/ |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
help with transpose-like macro
Thank you all for your help. I really should apologise because looking
back now i see that i excluded some important bits of info. I should have said that the rows are of varying length, not fixed as it looks from my sheet drawing. The other detail is that the function needs to be transpose the rows at any position in a worksheet, not just at the A:1 position. I wrote a macro after work which hopefully does the trick , if anyone wants to have a good laugh here it is, (this is my first macro, im just learning as i go) Sub Macro1() ' ' Macro1 Macro ' Macro recorded 18/02/2004 by Stu ' ' Dim count As Integer count = 0 Dim col As Integer col = ActiveCell.Column Do While IsEmpty(ActiveCell.Offset(0, 1)) = False count = count + 1 ActiveCell.Offset(0, 1).Select Loop ActiveCell.Offset(0, -count).Select Dim temp As Integer temp = count Do While temp 0 ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select Selection.Insert Shift:=xlDown temp = temp - 1 Loop ActiveCell.Offset(-count, col).Range("A1").Select Dim i As Integer Dim j As Integer i = 1 j = -1 temp = count Do While temp 0 Selection.Cut Destination:=ActiveCell.Offset(i, j).Range("A1") ActiveCell.Offset(0, 1).Range("A1").Select i = i + 1 j = j - 1 temp = temp - 1 Loop temp = count + 1 ActiveCell.Offset(temp, -temp).Range("A1").Select End Sub --- Message posted from http://www.ExcelForum.com/ |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
help with transpose-like macro
Maybe try the sub colrows1 below?
[Slightly amended the sub given by MVP Gord Dibben] Steps to run are given in the comments [essentially select input range run sub specify topleft cell of output range] Sub colrows1() 'Amended [Original sub by GordDibben_.programming_19Feb2004] 'Steps: 'Select the input range (e.g.: select B7:E9) and then run the sub 'Enter the top left cell for the output range when prompted, e.g.: B11 'Sub will output to a 2 column range with the top left cell as entered Dim SrcRg As Range Dim DestCell1 As Range Dim RowCounter As Long, ColOffset As Integer Dim CurrCell As Range Application.ScreenUpdating = False Set SrcRg = Selection.Columns(1) Set DestCell1 = Range(InputBox("Enter topleft cell" _ & vbCrLf & "for the output range")) For Each CurrCell In SrcRg.Cells ColOffset = 1 While CurrCell.Offset(0, ColOffset).Value < "" DestCell1.Offset(RowCounter).Value = CurrCell.Value DestCell1.Offset(RowCounter, 1).Value = CurrCell.Offset(0, _ ColOffset).Value RowCounter = RowCounter + 1 ColOffset = ColOffset + 1 Wend Next End Sub -- Rgds Max xl 97 ---------------------------------- Use xdemechanik <atyahoo<dotcom for email ----------------------------------------- "irato " wrote in message ... Thank you all for your help. I really should apologise because looking back now i see that i excluded some important bits of info. I should have said that the rows are of varying length, not fixed as it looks from my sheet drawing. The other detail is that the function needs to be transpose the rows at any position in a worksheet, not just at the A:1 position. I wrote a macro after work which hopefully does the trick , if anyone wants to have a good laugh here it is, (this is my first macro, im just learning as i go) Sub Macro1() ' ' Macro1 Macro ' Macro recorded 18/02/2004 by Stu ' ' Dim count As Integer count = 0 Dim col As Integer col = ActiveCell.Column Do While IsEmpty(ActiveCell.Offset(0, 1)) = False count = count + 1 ActiveCell.Offset(0, 1).Select Loop ActiveCell.Offset(0, -count).Select Dim temp As Integer temp = count Do While temp 0 ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select Selection.Insert Shift:=xlDown temp = temp - 1 Loop ActiveCell.Offset(-count, col).Range("A1").Select Dim i As Integer Dim j As Integer i = 1 j = -1 temp = count Do While temp 0 Selection.Cut Destination:=ActiveCell.Offset(i, j).Range("A1") ActiveCell.Offset(0, 1).Range("A1").Select i = i + 1 j = j - 1 temp = temp - 1 Loop temp = count + 1 ActiveCell.Offset(temp, -temp).Range("A1").Select End Sub --- Message posted from http://www.ExcelForum.com/ |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Transpose or Macro? | Excel Discussion (Misc queries) | |||
Do I need a Macro to do Transpose in this case? | Excel Discussion (Misc queries) | |||
I need a macro to transpose multiple columns A1-Z1, A2-X2 etc | Excel Discussion (Misc queries) | |||
Transpose Macro | Excel Worksheet Functions | |||
Transpose date macro | Excel Worksheet Functions |