Transpose data with formulas unchanged VBA

Question

Code :

Sub transposeTest()
   Dim transposedVariant As Variant
   Dim sourceRowRange As Range
   Dim sourceRowRangeVariant As Variant

   Set sourceRowRange = Selection
   sourceRowRangeVariant = sourceRowRange.Value
   transposedVariant = Application.Transpose(sourceRowRangeVariant)

   Dim rangeFilledWithTransposedData As Range
   Set rangeFilledWithTransposedData = Application.InputBox("Select cell to transpose selected data :", "Transpose Data", , , , , , 8) ' eight rows, one column
   rangeFilledWithTransposedData.Value = transposedVariant
End Sub

Range that I need to transpose with their formulas.

sourceRowRange is the Selection done by user, example : image RangeFilledWithTransposedData is the cell that user selects for transposing the selected range. User wants the flexibility to select a range for transposing and also flexible enough to transpose data wherever they want in the current sheet.

As you can see, D3 is formula, which is =B3*C3. Similarly,formula goes for rest cells in Column D.

Now, on using the above code I face 2 problems :
1. I have to select the output cell, as you can see the in the code. But when I do that, only the first value is pasted in that output cell, i.e. the value is printed as "1" from B3. But when I select a range for the output cell, for example same number of cells as my selection, then I get all the transposed columns. This means that If I select 2 cells, then only 2 cells will be transposed, if I select 10 cells, then 10 cells will be transposed. It doesnt transpose all the cells from the selection until I provide same number of cells as my selection.

2. The formulas don't get transposed. Only the values from column D gets transposed. Any way to transpose data with their respective formulas ?

Possible duplicate of [Transpose a range in VBA](https://stackoverflow.com/questions/13174916/transpose-a-range-in-vba) — Samuel Hulla, Jun 13 '18 at 08:19
@Rawrplus The code posted by dee is the one that I used above with some changes. — Aman Devrath, Jun 13 '18 at 08:32

DirtyDeffy · Accepted Answer · 2018-06-14T19:33:34.490

This should work:

Sub test()
Application.ScreenUpdating = False

Dim ws As Worksheet: Set ws = Worksheets("Sheet1") 'Type the sheet where the data is pasted
Dim myRows As Long
Dim myColumns As Long
Dim rng As Range
Dim userInput As String
Dim Outputrng As Range
Dim rowCounter As Long
Dim columnCounter As Long

myColumns = Selection.Columns.Count

userInput = InputBox("Type output cell eg. B10")
If userInput = vbNullString Then Exit Sub

rowCounter = 0
columnCounter = -1

For Each rng In Selection

    columnCounter = columnCounter + 1

    If columnCounter > myColumns - 1 Then columnCounter = -1

    If columnCounter = -1 Then
        rowCounter = rowCounter + 1
        columnCounter = 0
    End If

    Set Outputrng = ws.Range(userInput).Offset(columnCounter, rowCounter)

        If rng.HasFormula = True Then
           rng.Formula = Application.ConvertFormula(rng.Formula, xlA1, xlA1, 1)
        End If

    rng.Copy
    Outputrng.PasteSpecial xlPasteFormulas

Next

Application.ScreenUpdating = True
End Sub

Remember that if your formulas use relative cell references, you might get unexpected results.

Explanation of the code:

myColumns = Selection.Columns.Count

The code snippet above stores the number of columns in the selected area for future use.

userInput = InputBox("Type output cell eg. B10")
If userInput = vbNullString Then Exit Sub

The code snippet above prompts an InputBox in which the user can write the desired output cell. The output cell is going to be the top-left cell of the transposed data. The If statement exits the sub if the user doesn't type a value.

The For Each rng In Selection loop goes through each cell in the selected range. The code loops through columns from left to right first, then goes down a row and loops through columns again. The general idea with this loop is to identify the position of the cell and then paste it to the corresponding transposed position.

The columnCounter and rowCounter keeps track of the position of the cell. columnCounter = 0 and rowCounter = 0 would be the very first cell to be transposed. This cell is pasted to the output cell specified by the user. columnCounter = 1 and rowCounter = 0 would be the second cell to be transposed. This cell is pasted in the same column, but one row below the output cell.

At the beginning of each loop, the value of columnCounter is increased by 1, which can be seen on the line columnCounter = columnCounter + 1.

When the value of columnCounter becomes greater than the value of myColumns the value of columnCounter is set to -1. When the value of columnCounter is -1 the value of rowCounter is increased by 1 and the value of columnCounter is reset to 0. This means that the loop has finished going through the columns in one row and is now moving on to the next row.
All this can be seen in the following code snippet:

If columnCounter > myColumns - 1 Then columnCounter = -1

If columnCounter = -1 Then
   rowCounter = rowCounter + 1
   columnCounter = 0
End If

Now that the location of the cell is identified we need to paste it to the correct "output range", which is called Outputrng in the code. This is done in the following line:

Set Outputrng = ws.Range(userInput).Offset(columnCounter, rowCounter)

The basis for this line is the Range(userInput). This is the original output cell specified by the user via the InputBox. Using .Offset we can work with a cell relative to the user-specified output cell. Since we need to transpose the original selection, we invert the position of the original cell using columnCounter and rowCounter.
Note that columnCounter is used as the row offset while rowCounter is used as the column offset.

Next we check if the cell contains a formula. If it does, the formula is converted to absolute reference. This is done via the following code lines:

If rng.HasFormula = True Then
   rng.Formula = Application.ConvertFormula(rng.Formula, xlA1, xlA1, 1)
End If

Notice that the 1 at the end is what specifies that we want absolute reference. If we want relative reference, just change the 1 to a 4.

Last step is to paste the original cell to the Outputrng. To make sure that we paste the formulas as well, we use .PasteSpecial xlPasteFormulas. If the cell doesn't contain a formula, then the value is pasted. This is done on the following code lines:

rng.Copy
Outputrng.PasteSpecial xlPasteFormulas

Using Next tells the code to go to the next cell in the selection, which is called rng in the code.

This might not be the simplest or most elegant approach, but this is how I would do it - and it works! :)

It worked. But got 1 problem. Column B & C got copied perfectly with same values. But values in Column D became 0 after transposing. — Aman Devrath, Jun 13 '18 at 12:09
Like i said - if the formulas use relative cell references you are going to refer to new cells. Eg. if you have the following formula in cell `D4`: `=B4*C4` and transpose it to cell `C10` the formula will look like this: `=A10*B10`. This gives cell `C10` a new or even wrong value. You can try to use absolute cell references like this: `=$B$4*$C$4`. — DirtyDeffy, Jun 13 '18 at 12:23
oh.. Now it works properly. Thank you mate. Theres one thing that I want to ask. This column D which has the value, is entered by user. So if user entered formula uses relative cell references, this wont work - as said by you. So is it possible that before transposing the cells, selected cells (if it has formula), it'll be first converted into absolute cell references and then transpose ? — Aman Devrath, Jun 13 '18 at 12:32
Fortunately there is a way to do that. See my updated answer :) — DirtyDeffy, Jun 13 '18 at 12:55
That worked perfectly. Thank you so much. Can you explain me the changes ? — Aman Devrath, Jun 14 '18 at 08:14
@AmanDevrath Awesome - All changes or just this last part with absolute references? :) — DirtyDeffy, Jun 14 '18 at 08:34
Actually, if you have time, can you explain me the whole code ? I couldn't figure out how did that rowCounter and columnCounter worked. and also the new changes. — Aman Devrath, Jun 14 '18 at 09:27
@AmanDevrath I don't have the time right now unfortunately, but I will gladly add a full explanation when i get the time :) — DirtyDeffy, Jun 14 '18 at 09:31
@AmanDevrath I've updated my answer to include an explanation of the code. I hope I've explained myself clearly enough for others to understand it :) — DirtyDeffy, Jun 14 '18 at 19:34
wow man, you are one of the greatest. Thanx a lot. Your explanation was very helpful. — Aman Devrath, Jun 18 '18 at 07:46

Transpose data with formulas unchanged VBA

1 Answers1