Forum Discussion
SarahD33
Oct 25, 2022Copper Contributor
insert columns to rows without overwriting row header
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(?)
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).
- SnowMan55Bronze Contributor
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).