Oct 25 2022 09:59 AM
I have several columns and want to transpose them to rows but insert the rows vs overwrite, is that possible? So I have
A |1|2|3
A|4|5|6
And I want:
A|1
A|2
A|3
A|4
A|5
A|6
Any thoughts(?)
Nov 05 2022 11:45 PM
Solution@SarahD33 I would not call your sample transformation a "transpose", as it does not result in a similar rectangle of data, but... With a (rectangular-block) selection range like this:
... to copy the cells into one column (immediately below the selection) into new rows that are inserted like this:
(Note that the filled column in the new rows was the left-most column of the selection range.)
... requires VBA code, AFAIK:
Sub CopyCellsToIndividualNewRows()
' This procedure copies cell values from the (rectangular-block) selection
' range to new rows that are inserted immediately below the selection
' -- one row for each cell -- left-to-right, top-to-bottom.
Const strPROCEDURE_NAME = "CopyCellsToIndividualNewRows"
Dim objWorksheet As Worksheet
Dim strSelectionRange As String
'
Dim strMessage As String
Dim in4UserResponse As VbMsgBoxResult
'
Dim in4SelectionCols As Long
Dim in4SelectionRows As Long
Dim strAddrComponents() As String 'first for range address components, _
then for cell address components
Dim strTopLeftAddress As String
Dim strBottomRightAddress As String
'
Dim strSrcFirstCol As String
Dim strSrcLastCol As String
Dim in4SrcTopRow As Long
Dim in4SrcBottomRow As Long
'
Dim in4NewRows As Long
Dim in4DestRow As Long
'
Dim in4SrcRowIteration As Long
Dim in4SrcColIteration As Long
'---- Capture the selection range. Ensure that multiple,
' contiguous cells were selected.
Set objWorksheet = ActiveSheet
strSelectionRange = Selection.Address
If InStr(1, strSelectionRange, ":") = 0 Then
strMessage = "Sorry, but the selection must be a contiguous range."
Call MsgBox(strMessage, vbExclamation Or vbOKOnly, strPROCEDURE_NAME)
Exit Sub
End If
If InStr(1, strSelectionRange, ",") > 0 Then
strMessage = "Sorry, but the selection must be a contiguous range."
Call MsgBox(strMessage, vbExclamation Or vbOKOnly, strPROCEDURE_NAME)
Exit Sub
End If
'---- Extract info from the selection range.
in4SelectionCols = Selection.Columns.Count
in4SelectionRows = Selection.Rows.Count
'
strAddrComponents = Split(strSelectionRange, ":")
Debug.Assert UBound(strAddrComponents) = 1
strTopLeftAddress = strAddrComponents(0)
strBottomRightAddress = strAddrComponents(1)
'
strAddrComponents = Split(strTopLeftAddress, "$")
Debug.Assert UBound(strAddrComponents) = 2
strSrcFirstCol = strAddrComponents(1)
in4SrcTopRow = CLng(strAddrComponents(2))
'
strAddrComponents = Split(strBottomRightAddress, "$")
Debug.Assert UBound(strAddrComponents) = 2
strSrcLastCol = strAddrComponents(1)
in4SrcBottomRow = CLng(strAddrComponents(2))
' --
in4NewRows = in4SelectionCols * in4SelectionRows
'---- Insert new rows.
Application.ScreenUpdating = False
'
With objWorksheet
.Range("A" & CStr(in4SrcBottomRow + 1)).EntireRow.Select
For in4SrcRowIteration = 1 To in4NewRows
Selection.Insert shift:=xlShiftDown
Next in4SrcRowIteration
End With
'---- Copy the selection-range cell values to the new rows.
in4DestRow = in4SrcBottomRow
With objWorksheet
For in4SrcRowIteration = in4SrcTopRow To in4SrcBottomRow
.Range(strSrcFirstCol & CStr(in4SrcRowIteration)).Select
For in4SrcColIteration = 0 To in4SelectionCols - 1
in4DestRow = in4DestRow + 1
.Range(strSrcFirstCol & CStr(in4DestRow)).Value = _
Selection.Offset(0, in4SrcColIteration).Value
Next in4SrcColIteration
Next in4SrcRowIteration
.Range(strSrcFirstCol & CStr(in4SrcBottomRow + 1)).Select
End With
'
Application.ScreenUpdating = True
'
strMessage = Format$(in4NewRows, "#,###,###,##0") _
& " cell values were copied to new rows"
Call MsgBox(strMessage, vbInformation Or vbOKOnly, strPROCEDURE_NAME)
End Sub
Specific to this example, the code intentionally does not place content into column A of the six new rows. Whether you want column A populated with a single "row header" value or whether you want the "row header" value to be copied from the corresponding row of each source cell, I can't tell from your sample data ... but to finish up is an easy manual copy operation either way.
I assumed that your address-list-item separator is a comma; if it is a semicolon, change the literal in line 41.
If you want to use this procedure on the content of one or more workbooks without converting them to macro-enabled workbooks, you could create this procedure in your Personal Workbook (PERSONAL.XLSB).
Nov 05 2022 11:45 PM
Solution@SarahD33 I would not call your sample transformation a "transpose", as it does not result in a similar rectangle of data, but... With a (rectangular-block) selection range like this:
... to copy the cells into one column (immediately below the selection) into new rows that are inserted like this:
(Note that the filled column in the new rows was the left-most column of the selection range.)
... requires VBA code, AFAIK:
Sub CopyCellsToIndividualNewRows()
' This procedure copies cell values from the (rectangular-block) selection
' range to new rows that are inserted immediately below the selection
' -- one row for each cell -- left-to-right, top-to-bottom.
Const strPROCEDURE_NAME = "CopyCellsToIndividualNewRows"
Dim objWorksheet As Worksheet
Dim strSelectionRange As String
'
Dim strMessage As String
Dim in4UserResponse As VbMsgBoxResult
'
Dim in4SelectionCols As Long
Dim in4SelectionRows As Long
Dim strAddrComponents() As String 'first for range address components, _
then for cell address components
Dim strTopLeftAddress As String
Dim strBottomRightAddress As String
'
Dim strSrcFirstCol As String
Dim strSrcLastCol As String
Dim in4SrcTopRow As Long
Dim in4SrcBottomRow As Long
'
Dim in4NewRows As Long
Dim in4DestRow As Long
'
Dim in4SrcRowIteration As Long
Dim in4SrcColIteration As Long
'---- Capture the selection range. Ensure that multiple,
' contiguous cells were selected.
Set objWorksheet = ActiveSheet
strSelectionRange = Selection.Address
If InStr(1, strSelectionRange, ":") = 0 Then
strMessage = "Sorry, but the selection must be a contiguous range."
Call MsgBox(strMessage, vbExclamation Or vbOKOnly, strPROCEDURE_NAME)
Exit Sub
End If
If InStr(1, strSelectionRange, ",") > 0 Then
strMessage = "Sorry, but the selection must be a contiguous range."
Call MsgBox(strMessage, vbExclamation Or vbOKOnly, strPROCEDURE_NAME)
Exit Sub
End If
'---- Extract info from the selection range.
in4SelectionCols = Selection.Columns.Count
in4SelectionRows = Selection.Rows.Count
'
strAddrComponents = Split(strSelectionRange, ":")
Debug.Assert UBound(strAddrComponents) = 1
strTopLeftAddress = strAddrComponents(0)
strBottomRightAddress = strAddrComponents(1)
'
strAddrComponents = Split(strTopLeftAddress, "$")
Debug.Assert UBound(strAddrComponents) = 2
strSrcFirstCol = strAddrComponents(1)
in4SrcTopRow = CLng(strAddrComponents(2))
'
strAddrComponents = Split(strBottomRightAddress, "$")
Debug.Assert UBound(strAddrComponents) = 2
strSrcLastCol = strAddrComponents(1)
in4SrcBottomRow = CLng(strAddrComponents(2))
' --
in4NewRows = in4SelectionCols * in4SelectionRows
'---- Insert new rows.
Application.ScreenUpdating = False
'
With objWorksheet
.Range("A" & CStr(in4SrcBottomRow + 1)).EntireRow.Select
For in4SrcRowIteration = 1 To in4NewRows
Selection.Insert shift:=xlShiftDown
Next in4SrcRowIteration
End With
'---- Copy the selection-range cell values to the new rows.
in4DestRow = in4SrcBottomRow
With objWorksheet
For in4SrcRowIteration = in4SrcTopRow To in4SrcBottomRow
.Range(strSrcFirstCol & CStr(in4SrcRowIteration)).Select
For in4SrcColIteration = 0 To in4SelectionCols - 1
in4DestRow = in4DestRow + 1
.Range(strSrcFirstCol & CStr(in4DestRow)).Value = _
Selection.Offset(0, in4SrcColIteration).Value
Next in4SrcColIteration
Next in4SrcRowIteration
.Range(strSrcFirstCol & CStr(in4SrcBottomRow + 1)).Select
End With
'
Application.ScreenUpdating = True
'
strMessage = Format$(in4NewRows, "#,###,###,##0") _
& " cell values were copied to new rows"
Call MsgBox(strMessage, vbInformation Or vbOKOnly, strPROCEDURE_NAME)
End Sub
Specific to this example, the code intentionally does not place content into column A of the six new rows. Whether you want column A populated with a single "row header" value or whether you want the "row header" value to be copied from the corresponding row of each source cell, I can't tell from your sample data ... but to finish up is an easy manual copy operation either way.
I assumed that your address-list-item separator is a comma; if it is a semicolon, change the literal in line 41.
If you want to use this procedure on the content of one or more workbooks without converting them to macro-enabled workbooks, you could create this procedure in your Personal Workbook (PERSONAL.XLSB).