Add a copy/transpose feature

Just realized that there is not a Copy equivalent of the Cut/Transpose feature. This need to work in the same way: the entire cell is essentially moved/duplicated without consideration for relative references. This means you cannot just use Copy to do it.

This should work

Sub copytranspose()
Dim rngSrc As Range
Set rngSrc = Application.InputBox("What range do you want to transpose?", Type:=8)

Dim rRow As Integer
rRow = rngSrc.Rows.Count

Dim rCol As Integer
rCol = rngSrc.Columns.Count

Dim arrTranspose() As Variant
ReDim arrTranspose(1 To rCol, 1 To rRow)
For i = 1 To rRow
    For j = 1 To rCol
        arrTranspose(j, i) = rngSrc.Cells(i, j)
    Next j
Next i

Dim rngDest As Range
Set rngDest = Application.InputBox("Where would you like this to output?", Type:=8)
rngDest.Resize(UBound(arrTranspose, 1), UBound(arrTranspose, 2)).Value = arrTranspose


End Sub

This is a good start. I would add an extra check in there so that it will copy the formula exactly if it has one.

The idea is that there might be a time where you want to copy/transpose a range of cells but not have their formulas update due to the relative shift (changing a column summary to a row summary is a typical example where I have used this). A "normal" copy/transpose will ruin the formulas. This is easy for Cut since it takes the cell as is and just moves it along with all its references. For this case, I would throw in an extra HasFormula check where it then reproduces the formula in the new cell if it has a formula. If no formula, then the value is good. (You can use the Formula for all cases though because it will pull the Value if there is not an actual Formula)

One other consideration is that the Cut version technically works with a discontinuous range since it processes the cells one at a time using a For Each. This version would overwrite cells in the middle if a discontinuous range was used. This is a bit of an edge case, but I always like to support discontinuous ranges where I can. They come up often enough using SpecialCells and when filtering ranges and selecting visible cells only (ALT+SEMICOLON).

I suspect pulling the formulas from the cells will require that the cells be processed one by one instead of using the array. I don't think you can output an array of different formulas into a range of cells? In that sense, using the formulas will solve both problems.

Sorry if the intent of this function was not clear from the description. I will get descriptions written up today.

So if the target range was say "A1:A3"&"A5:A7" with the destination being B1 - would it go across column one leaving E1 blank, or shifting to the left?

It would skip E1 and leave a blank so that the source and destination are mirror images of each other.

I believe the blank skipping is the justification for the offset math in the CutPasteTranspose Sub:

bUTL/src/code/Usability.vba

Line 282 in 0c6dd0c

ActiveSheet.Cells(iORow + c.Column - iCCol, iOCol + c.Row - iCRow).Activate

. I think the Copy version of this should look very similar except replacing the Cut/Paste logic with the value/formula discussion from above.

All right, basing this off cut-transpose -

Sub CopyTranspose()

    'If user cancels a range input, we need to handle it when it occurs
    On Error GoTo errCancel
    Dim rngSelect As Range
    Set rngSelect = Selection

    Dim rngOut As Range
    Set rngOut = Application.InputBox("Select output corner", Type:=8)

    'Application.ScreenUpdating = False
    'Application.EnableEvents = False
    'Application.Calculation = xlCalculationManual

    Dim rCorner As Range
    Set rCorner = rngSelect.Cells(1, 1)

    Dim iCRow As Integer
    iCRow = rCorner.Row
    Dim iCCol As Integer
    iCCol = rCorner.Column

    Dim iORow As Integer
    Dim iOCol As Integer
    iORow = rngOut.Row
    iOCol = rngOut.Column

    Dim c As Range
    For Each c In rngSelect
        If Not Intersect(rngSelect, Cells(iORow + c.Column - iCCol, iOCol + c.Row - iCRow)) Is Nothing Then
            MsgBox ("Your destination intersects with your data")
            Exit Sub
        End If
    Next

    For Each c In rngSelect

        ActiveSheet.Cells(iORow + c.Column - iCCol, iOCol + c.Row - iCRow).Formula = c.Formula

    Next c

    'Application.CutCopyMode = False

    'Application.ScreenUpdating = True
    'Application.EnableEvents = True
    'Application.Calculation = xlCalculationAutomatic
    'Application.Calculate
errCancel:
End Sub

Is that what we're looking for?

It should be noted that this keeps absolute references, because the data is remaining where it is, even if it's copied.

With cutpastetranspose the references break if you have any of the referenced cells in your selection.

It might actually be better to use the copytranspose for cuttranspose by just c.clearcontents after doing the copy:

    For Each c In rngSelect
        ActiveSheet.Cells(iORow + c.Column - iCCol, iOCol + c.Row - iCRow).Formula = c.Formula
        c.ClearContents
    Next c

This avoids any of the activation business as well as doing actual cut & paste - which is slower than doing it directly. It still has references break if they are within the selection.

Wait, I got it

For Each c In rngSelect
        c.Copy
        ActiveSheet.Cells(iORow + c.Column - iCCol, iOCol + c.Row - iCRow).PasteSpecial Transpose:=True
        c.ClearContents
    Next c

This will change references to be relative with cut/transpose - but that might not be what you want if the cut doesn't include any of the referenced values.

It's almost as if we'd need to loop through each c.formula to see if the references are within rngselect, then decide which way to process it. But, then again, you could reference both inside and outside of the selection. Hmm

That code looks like what I was thinking, and you're right about the absolute references. That's not going to work if the selection includes references inside itself.... hmm. Maybe we just stick to the cut version.

The idea with the copy version is that you could duplicate a data table while transposing rows and columns to flip it around. This might be useful for reporting purposes or making a PivotTable where you don't want to mess with the underlying fields.

This was added in the last sync and can be closed.