# vba Copy Paste Transpose Link

Following takes a range & copies, pastes, transposes & links. There doesn't seem a way in vba to do this in 1 go that I've been able to find.

Questions are;

1. Is there a more efficient or safer way to do this. Keeping in mind;
-needing to do this for large ranges ie. over 100K cells.
-source & destination are in different worksheets or workbooks. So not the same worksheet.
2. What issues if any may exist & how to safeguard.

Thank you

Sub Foo()

'Example1
Call CopyPaste(Sheet1.Range("C10:D20"), Sheet2.Range("C1"))

'Example2
Dim wbNew As Workbook
Call CopyPaste(ThisWorkbook.Sheets(1).Range("C10:D20"), wbNew.Sheets(1).Range("C1"))

End Sub

Sub CopyPaste(rngSrc As Range, rngDest As Range)

Application.ScreenUpdating = False
Dim wsDummy As Worksheet
Set wsDummy = ActiveWorkbook.Sheets("_wsDummy_Temp_")

rngSrc.Copy
wsDummy.Activate
wsDummy.Range("A1").Select

Dim vTransposed As Variant
Dim rngSrcSrcRng As Range
Dim vSrcSrc As Variant

Dim rngDummy As Range
Set rngDummy = wsDummy.Range("A1")
Set rngDummy = rngDummy.Resize(rngSrc.Rows.Count, rngSrc.Columns.Count)
rngDummy.Formula = Application.ConvertFormula(rngDummy.Formula, xlA1, xlA1, 1)

Set rngSrcSrcRng = rngDummy
vSrcSrc = rngSrcSrcRng.Formula
vTransposed = Application.Transpose(vSrcSrc)

Set rngDest = rngDest.Resize(rngDummy.Columns.Count, rngDummy.Rows.Count)
rngDest.Formula = vTransposed

rngDummy.ClearContents
wsDummy.Delete
Application.ScreenUpdating = True

End Sub


EDIT:

With the answer provided @TinMan I decided to fill over a 1M cells in a worksheet with numbers & do some benchmarking.

Original OP function: 33 to 39 seconds.
Refactored CopyPaste function: 20 to 26 seconds.
Alternate Approach TransposeLink function: 11 to 13 seconds.

It appears the last one is the fastest in the tests I did but also removes the need to use another temporary worksheet, removes need to use select or the clipboard.

• Do you have calculations set to manual? – TinMan Jul 4 at 23:44
• No I haven't & I hadn't even thought of that. At the moment this is quite quick & haven't noticed any slowdown, but as the range grows I guess that may be an issue. – tnuba Jul 5 at 20:25

## Review

Private Sub CopyPaste(rngSrc As Range, rngDest As Range)


Prefixing variables with their type is a bit dated. Of course there are times when it is invaluable such as working with forms where their is a designer and a code module. Using simple meaningful names will make you code easier to read.

Private Sub CopyPaste(Source As Range, Destination As Range)


There is no need to name temporary objects.

ActiveWorkbook.Sheets.Add.Name = "_wsDummy_Temp_"
Dim wsDummy As Worksheet
Set wsDummy = ActiveWorkbook.Sheets("_wsDummy_Temp_")


It better to set your variables directly whenever possible.

Set wsDummy = ActiveWorkbook.Sheets.Add


Since the worksheet is just temporary and the code is short, I would use a With block and eliminate the wsDummy variable altogether.

With ActiveWorkbook.Sheets.Add
<more code>
End With


Worksheets are activated with Range("A1") selected whenever they are added. So eliminate these lines:

wsDummy.Activate
wsDummy.Range("A1").Select


Ay-ay-ay rngSrcSrcRng!! This variable is just an alias for rngDummy. Pick a name and stick with it. I take this concept to the extreme. You will see the same names throughout all my code projects. IMO, consistently using simple names like data ( array ), results ( array ), result (scalar value), r (row index) , c (column index), n (generic index), text ( simple string ), contents ( simple string usually file contents), source (source object such as a range) , destination (destination object such as a range), cell, target don't just make it easier to read and modify your code but it also makes it far quicker to write the code, in the first place.

vTransposed isn't needed either. It would be better to reuse vSrcSrc then to keep both variables in memory.

Clearing the contents of a temporary worksheet. I'm guessing this is a remnant of code from your earlier attempts.

rngDummy.ClearContents


After your macros complete Application.DisplayAlerts and Application.ScreenUpdating are automatically reset. So these lines can be removed:

Application.DisplayAlerts = True
Application.ScreenUpdating = True


It is best to set Application.Calculation = xlCalculationManual when changing values or formulas on a worksheet.

## Refactored Code

Private Sub CopyPaste(Source As Range, Destination As Range)
Application.ScreenUpdating = False

Dim calculationMode As XlCalculation
calculationMode = Application.Calculation

Dim results As Variant

Source.Copy
With .Range("A1").CurrentRegion
results = Application.ConvertFormula(.Formula, xlA1, xlA1, 1)
Destination.Resize(.Columns.Count, .Rows.Count) = Application.Transpose(results)
End With
.Delete
End With

Application.Calculation = calculationMode
End Sub


## Alternate Approach

A more efficient method create the formula array using Range.Address(RowAbsolute:=True, ColumnAbsolute:=True, External:=True). This will eliminate the need for a temporary worksheet and avoid the copy and pasting.

 Private Sub TransposeLink(Source As Range, Destination As Range)
Application.ScreenUpdating = False

Dim calculationMode As XlCalculation
calculationMode = Application.Calculation

Dim results As Variant
With Source
ReDim results(1 To .Columns.Count, 1 To .Rows.Count)

Dim r As Long, c As Long

For r = 1 To .Rows.Count
For c = 1 To .Columns.Count
results(c, r) = "=" & .Cells(r, c).Address(RowAbsolute:=True, ColumnAbsolute:=True, External:=True)
Next
Next

Destination.Resize(.Columns.Count, .Rows.Count).Formula = results
End With

Application.Calculation = calculationMode
End Sub

• After I posted I noticed some issues, thanks. I'll update my OP soon with some benchmarking. – tnuba Jul 6 at 21:11
• @tnuba By the way, great concept! Excel should implement it. – TinMan Jul 6 at 21:17
• Yes I don't know why MS don't, it's a much sought after functionality. I find myself needing to do this way too much hence my post. Knew there would be a better way & knew using select or activate isn't always good idea, just didn't know how as haven't been using vba that long. So thanks. – tnuba Jul 6 at 21:33
• I noticed that your alternate method didn't handle ranges with multiple areas well, so I added another answer building on it. Cheers – Taylor Scott Jul 8 at 4:09

## A modification if Tinman's Alternate Approach

Because .Rows.Count and .Columns.Count do not encapsulate the entirety of ranges which have more than one area (that is, where .Areas.Count >1) TransposeLink as defined above needs some modifcation to handle these cases.

Namely, we will have to define an helper function that gets the footprint of all of the areas of source, then iterate across the rows and columns of that footprint rather than of source directly. In doing so, we also must check if the footprint Intersects with source, and only iff that is the case, transfer over the formula.

Application of these changes renders code somewhere along the lines of the below.

Option Compare Binary
Option Explicit
Option Base 1

Public Sub TransposeLink(ByRef src As Range, ByRef dest As Range)
Dim ASU As Boolean, _
ACM As Excel.XlCalculation, _
row As Long, _
col As Long

With Application
Let ASU = .ScreenUpdating: Let .ScreenUpdating = False
Let ACM = .Calculation:    Let .Calculation = Excel.XlCalculation.xlCalculationManual
End With

With footprint(src)
ReDim res(1 To .Columns.Count, 1 To .Rows.Count)            '' dim in as variant()
Let res = dest.Resize(.Columns.Count, .Rows.Count).Formula  '' to not overwrite data
For row = 1 To .Rows.Count
For col = 1 To .Columns.Count
If Not Intersect(.Cells(row, col), src) Is Nothing Then _
Let res(col, row) = "=" & .Cells(row, col).Address(RowAbsolute:=True, ColumnAbsolute:=True, External:=True)
Next col, row
Let dest.Resize(.Columns.Count, .Rows.Count).Formula = res
End With

With Application
Let .ScreenUpdating = ASU
Let .Calculation = ACM
End With
End Sub

Public Function footprint(ByRef rng As Range) As Range

Dim numAreas           As Long, _
rMin As Long, rMax As Long, _
cMin As Long, cMax As Long, _
iter As Long

Let numAreas = rng.Areas.Count
If numAreas = 1 Then Set footprint = rng: Exit Function

For iter = 1 To numAreas
With rng.Areas(iter)
If iter = 1 Then
Let rMin = .Item(1).row
Let cMin = .Item(1).Column
Let rMax = .Item(.Count).row
Let cMax = .Item(.Count).Column
Else
If .Item(1).row < rMin Then Let rMin = .Item(1).row
If .Item(1).Column < cMin Then Let cMin = .Item(1).Column
If .Item(.Count).row > rMax Then Let rMax = .Item(.Count).row
If .Item(.Count).Column > cMax Then Let cMax = .Item(.Count).Column
End If
End With
Next iter

With rng.Worksheet
Set footprint = .Range(.Cells(rMin, cMin), .Cells(rMax, cMax))
End With
End Function


Note the addition of the Option Explicit module option at the top of this code segment - enabling this helps you to keep track of your what variables you are using by forcing you to dim them in before using them.

## Testing

A simple test which illustrates the impact is

Sub trans_test()
' yellow - source
TransposeLink [A1,C3,E5], [I3]          ' green  - new
OLD_TransposeLink [A1,C3,E5], [Q5]      ' red    - old

Cells.Style = "normal"
[A1,C3,E5].offset(0, 0).Style = "neutral"
[A1,C3,E5].offset([I3].row - 1, [I3].Column - 1).Style = "good"
[A1,C3,E5].offset([Q5].row - 1, [Q5].Column - 1).Style = "bad"

End Sub


where OLD_TransposeLink is the original version of the subroutine and which generates the worksheet shown below. In this example, a background set of formulas is generated, and then A1, C3, and E5 (highlighted in yellow) are selected as the data source. The green highlighted region represents the pasting operation completed by the changed script and the red highlighted region represents that of the original script. Note that in the original output, 3C and 5E` are not properly copied over from the source.

Note: top left cell is cell A1

• Very cleaver. I never would have thought to handle multiple areas. – TinMan Jul 8 at 6:11