Home |
Search |
Today's Posts |
#1
|
|||
|
|||
Transpose data into a single cloumn
Hi everyone
I have just started learning VBA and a friend designed the following macro. The macro takes information from Cell A2 to F2 and creates a new record in a single column. That is the is transposed from horizontal across columns to a single column, with line break at each record. This macro works very well. I would like to learn more about VBA and apply this knowledge using this macro. I would appreciate if a member could add some comments against each line so I can understand what the code is doing. For example is the following selecting the first record down to the last record in the worksheet. Range("A2").Select ' start point Selection.End(xlDown).Select ' bottom record lastRow = ActiveCell.Row Thanks Davidshe Sub UpdateData() ' assuming columns don't go beyond the Z column Dim lastColumn As String, currentRow As String, destinationArray As String 'string = text Dim i As Integer, lastRow, numOfColumns As Integer, destinationStart As Integer ' Interger = number Application.ScreenUpdating = False ' opening Range("A2").Select ' start point Selection.End(xlDown).Select ' bottom record lastRow = ActiveCell.Row Selection.End(xlToRight).Select numOfColumns = ActiveCell.Column + 1 lastColumn = (Chr(numOfColumns + 64)) ' maximum columns could be 1 to max etc ' should add in a line here to clear old tranposed data destinationStart = lastRow For i = 2 To lastRow currentRow = "A" & i & ":" & lastColumn & i destinationArray = "A" & destinationStart + 5 & ":A" & destinationStart + 3 + numOfColumns Range(destinationArray).FormulaArray = "=transpose(" & currentRow & ")" destinationStart = destinationStart + numOfColumns Next i Application.ScreenUpdating = True 'closing End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transpose data into a single cloumn
Hi David,
Am Sun, 31 Mar 2013 09:34:56 +0000 schrieb davidshe: I have just started learning VBA and a friend designed the following macro. The macro takes information from Cell A2 to F2 and creates a new record in a single column. That is the is transposed from horizontal across columns to a single column, with line break at each record. [Code snippet] Select, selection and Activate is not necessary if your referencies are explicit. I prefer a solution without formulas because formulas will be new calculated. My solution copies the range in each row in sheet1 and paste it in column A of sheet2: Sub UpdateData() Dim lastColumn As String Dim destinationArray As String 'string = text Dim numOfColumns As Integer Dim i As Long, lastRow As Long Dim destinationStart As Long Application.ScreenUpdating = False 'modify the sheet name With Sheets("Sheet1") lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row numOfColumns = .Cells(2, .Columns.Count).End(xlToLeft).Column destinationStart = 1 For i = 2 To lastRow .Range(.Cells(i, 1), .Cells(i, numOfColumns)).Copy 'modify the sheet name Sheets("Sheet2").Cells(destinationStart, 1) _ .PasteSpecial xlPasteAll, Transpose:=True destinationStart = destinationStart + numOfColumns Next End With Application.ScreenUpdating = True Application.CutCopyMode = False End Sub Regards Claus Busch -- Win XP PRof SP2 / Vista Ultimate SP2 Office 2003 SP2 /2007 Ultimate SP2 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transpose data into a single cloumn
Hi David,
Am Sun, 31 Mar 2013 17:04:44 +0200 schrieb Claus Busch: For i = 2 To lastRow .Range(.Cells(i, 1), .Cells(i, numOfColumns)).Copy 'modify the sheet name Sheets("Sheet2").Cells(destinationStart, 1) _ .PasteSpecial xlPasteAll, Transpose:=True destinationStart = destinationStart + numOfColumns Next if the numOfColumns differs from row to row you have to calculate it in the For-Next-statement: For i = 2 To lastRow numOfColumns = .Cells(i, .Columns.Count).End(xlToLeft).Column .Range(.Cells(i, 1), .Cells(i, numOfColumns)).Copy 'modify the sheet name Sheets("Sheet2").Cells(destinationStart, 1) _ .PasteSpecial xlPasteAll, Transpose:=True destinationStart = destinationStart + numOfColumns Next Regards Claus Busch -- Win XP PRof SP2 / Vista Ultimate SP2 Office 2003 SP2 /2007 Ultimate SP2 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transpose data into a single cloumn
Hi David,
Am Sun, 31 Mar 2013 17:04:44 +0200 schrieb Claus Busch: My solution copies the range in each row in sheet1 and paste it in column A of sheet2: but faster is a solution that writes the data in an array and then transpose back into the sheet: Option Base 1 Sub UpdateData2() Dim LRow As Long Dim LCol As Integer Dim i As Long, j As Long, k As Long, m As Long, n As Long Dim myArr() As Variant Dim st As Double st = Timer With Sheets("Sheet1") LRow = .Cells(.Rows.Count, "A").End(xlUp).Row For i = 2 To LRow LCol = .Cells(i, Columns.Count).End(xlToLeft).Column n = j j = j + LCol ReDim Preserve myArr(j) k = 1 For m = n + 1 To n + LCol myArr(m) = .Cells(i, k) k = k + 1 Next Next End With Sheets("Sheet2").Range("A1").Resize(UBound(myArr)) = _ WorksheetFunction.Transpose(myArr()) MsgBox Format(Timer - st, "0.000") & " sec" End Sub Regards Claus Busch -- Win XP PRof SP2 / Vista Ultimate SP2 Office 2003 SP2 /2007 Ultimate SP2 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transpose data into a single cloumn
Does Row1 contain headers? If so, why aren't you transposing them in
Col1? Can each row go in the next Col, or do they need to be stacked for some reason? This would give the following layout... H R R e o o a w w d 2 3 i D D n a a g t t s a a ...and so forth across the sheet. -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transpose data into a single cloumn
No point duplicating what Claus offers, so I went with what I proposed
so you have an alternative... Option Explicit Sub UpdateData3() Dim lMaxCols&, lLastRow&, lStartRow&, i&, n& '//as Long Dim vDataIn, vDataOut() '//as Variant 'Get the position of the last row and max columns '**Assumes source data is contiguous, 'and includes source data header row.** '<NoteTypically, header rows contain all data fields, 'for the underlying data table, 'whether all fields contain data or not!</Note With Range("A1") lLastRow = .End(xlDown).Row lMaxCols = .CurrentRegion.Columns.Count End With lStartRow = lLastRow + 2 '//offset from source data 'Delete any existing transposed data Dim l1&, l2& '//as Long l1 = Cells(lLastRow + 1, 1).Row l2 = Cells(l1, 1).End(xlDown).Row Range(l1 & ":" & l2).EntireRow.Delete 'Add some visual space below the source data, 'but ALWAYS have a blank row between source data 'and transposed data. Always insert new rows of 'source data ABOVE the blank row. Cells(lStartRow, 1).RowHeight = 30 '//edit to suit ReDim vDataOut(1 To lMaxCols, 1 To 1) '//transposed array For i = 1 To lLastRow vDataIn = Range(Cells(i, 1), Cells(i, lMaxCols)) For n = LBound(vDataIn) To UBound(vDataIn, 2) vDataOut(n, 1) = vDataIn(1, n) '//transpose cols to rows Next 'n Cells(lStartRow, i).Resize(lMaxCols, 1) = vDataOut Next 'i End Sub ...where I tested (initially) with 5 rows x 5 cols of source data, then *inserted* 5 more rows of data at Row6, and added 5 more cols to the right, and tested again with the new data. -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transpose data into a single cloumn
Oops! See below where copy/paste didn't go properly...
Sub UpdateData3() Dim lMaxCols&, lLastRow&, lStartRow&, i&, n& '//as Long Dim vDataIn, vDataOut() '//as Variant 'Get the position of the last row and max columns '**Assumes source data is contiguous, 'and includes source data header row.** '<NoteTypically, header rows contain all data fields, 'for the underlying data table, 'whether all fields contain data or not!</Note With Range("A1") lLastRow = .End(xlDown).Row lMaxCols = .CurrentRegion.Columns.Count End With lStartRow = lLastRow + 2 '//offset from source data 'Delete any existing transposed data Dim l1&, l2& '//as Long l1 = Cells(lLastRow, 1).End(xlDown).Row l2 = Cells(l1, 1).End(xlDown).Row Range(l1 & ":" & l2).EntireRow.Delete 'Add some visual space below the source data, 'but ALWAYS have a blank row between source data 'and transposed data. Always insert new rows of 'source data ABOVE the blank row. Cells(lStartRow, 1).RowHeight = 30 '//edit to suit ReDim vDataOut(1 To lMaxCols, 1 To 1) '//transposed array For i = 1 To lLastRow vDataIn = Range(Cells(i, 1), Cells(i, lMaxCols)) For n = LBound(vDataIn) To UBound(vDataIn, 2) vDataOut(n, 1) = vDataIn(1, n) '//transpose cols to rows Next 'n Cells(lStartRow, i).Resize(lMaxCols, 1) = vDataOut Next 'i End Sub ..where I tested (initially) with 5 rows x 5 cols of source data, then *inserted* 5 more rows of data at Row6, and added 5 more cols to the right, and tested again with the new data. -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Average selected data in a cloumn | Excel Discussion (Misc queries) | |||
Missing Cloumn data when importing external data | Excel Discussion (Misc queries) | |||
Transpose data from many horizontal rows into a single column | Excel Discussion (Misc queries) | |||
copying data from matching cloumn | Excel Worksheet Functions | |||
Transpose Rows to a single a Column one below other | Excel Programming |