vba Copy Paste Transpose Link

Question

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
 Set wbNew = Workbooks.Add
 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
 ActiveWorkbook.Sheets.Add.Name = "_wsDummy_Temp_"
 Dim wsDummy As Worksheet
 Set wsDummy = ActiveWorkbook.Sheets("_wsDummy_Temp_") 
 rngSrc.Copy
 wsDummy.Activate
 wsDummy.Range("A1").Select
 ActiveSheet.Paste Link:=True
 
 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
 Application.DisplayAlerts = False
 wsDummy.Delete
 Application.DisplayAlerts = True
 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.

• TinMan: Do you have calculations set to manual?
• tnuba: 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.

Answer 1

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
 .Paste Link:=True
 <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
 Application.DisplayAlerts = False
 
 Dim calculationMode As XlCalculation
 calculationMode = Application.Calculation
 
 Dim results As Variant
 Source.Copy
 With Worksheets.Add
 .Paste Link:=True
 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
 Application.DisplayAlerts = 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

• tnuba: After I posted I noticed some issues, thanks. I'll update my OP soon with some benchmarking.
• TinMan: @tnuba By the way, great concept! Excel should implement it.
• tnuba: 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.
• Taylor Raine: I noticed that your alternate method didn't handle ranges with multiple areas well, so I added another answer building on it. Cheers

Answer 2

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, _
 ADA As Boolean, _
 ACM As Excel.XlCalculation, _
 row As Long, _
 col As Long
 
 With Application
 Let ASU = .ScreenUpdating: Let .ScreenUpdating = False
 Let ADA = .DisplayAlerts: Let .DisplayAlerts = 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 .DisplayAlerts = ADA
 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()
 [A1:U9] = "=Right(Address(Row(),Column(),4))&Left(Address(Row(),Column(),4))"
 ' 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.

test-output

Note: top left cell is cell A1

• TinMan: Very cleaver. I never would have thought to handle multiple areas.