Is it possible to transpose a 3D cell reference to a 2D reference (either horizontal or vertical)?

Hi, A 3D reference is a formula that uses the same cells on a series of worksheets.

For example this formula:=SUM(SheetA:SheetC!B3:B5)sums the cells B3 to B5 on all the worksheets from a worksheet named Sheet A to the worksheet named Sheet C (in this example I had three sheets - the third being SheetB).

The formula was on a fourth Worksheet 'Sheet1'.To me, converting this to a 2D reference would mean having three formulas:

SUM(SheetA!B3:B5)

SUM(SheetB!B3:B5)

SUM(SheetC!B3:B5)The following Macro works with a selection of cells, and takes 3D formulas and creates a series of single sheet (2D) formulas in the cells below each 3D formula.

There isnocheck that the cells in the rows below the 3D formulas are empty - any existing data will be overwritten.The macro will ignore cells without formulas and it will ignore cells with formulas that do not reference another worksheet.

There are weaknesses with this, as it errors out if one of the cells in the selection refers to a single worksheet, i.e. it is not a 3D formula but it is referencing a cell on another worksheet.

The Macro does not attempt to recognize references to other workbooks and likely will error out if one is present in the selection.

I have only tested this with the SUM() function, but it should work on other simple functions with the same formula structure.

Option Explicit Private Sub ThreeDToTwoD() Dim rngCell As Range Dim strFmlaAddr As String Dim strFormula As String Dim strFunc As String Dim strSheets As String Dim strFirstSht As String Dim strLastSht As String Dim strCells As String Dim intRow As Integer Dim n As Integer On Error GoTo ErrHnd For Each rngCell In Selection 'only test cells with a formula and a worksheet name (has ! in formula) If rngCell.HasFormula = True And InStr(1, rngCell.Formula, "!") > 0 Then 'get 3D formula and get its component parts strFormula = Right(rngCell.Formula, Len(rngCell.Formula) - 1) strFunc = Left(strFormula, InStr(1, strFormula, "(")) strSheets = Mid(strFormula, InStr(1, strFormula, "(") + 1, _ InStr(1, strFormula, "!") - InStr(1, strFormula, "(") - 1) strFirstSht = Left(strSheets, InStr(1, strSheets, ":") - 1) strLastSht = Right(strSheets, Len(strSheets) - InStr(1, strSheets, ":")) strCells = Right(strFormula, Len(strFormula) - InStr(1, strFormula, "!")) 'set first row offset for new 2D formulas intRow = 1 'loop through all the worksheet names in the 3D range For n = Worksheets(strFirstSht).Index To Worksheets(strLastSht).Index 'create 2D formulas below 3D formula rngCell.Offset(intRow, 0).Formula = _ "=" & strFunc & Worksheets(n).Name & "!" & strCells 'next row intRow = intRow + 1 Next n End If Next rngCell Exit Sub

This would go into a standard module (not a Class module) attached to the workbook.As this is something that is unlikely to be run repeatedly on one workbook, it is not worth creating a command button to run it from. Just run it with f5 from the Visual Basic window. (If you want to try this and need more advice on macros, please ask)

If you try this macro, please note that it should be tested on a copy of your workbook, and always make a backup before running it as there is

no undo functionfor macros.Regards

Wow!! That's a lot more complicated than I expected. I've got no experience with Macros or VB. I'd like to poke around a bit.

Thanks very, very much.

Hi, I will provide further explanation on installing the macro and using it later in the day.

However I just noticed that I didn't copy the last part of the code when I posted it.

After Exit Sub there should be these additional lines:

'error handler

ErrHnd:

Err.Clear

MsgBox rngCell.Address

End SubRegards

I tried to run this on a 3D reference formula, but it didn't work. It opens the VB debug window and displays this error: Compile error: Invalid inside procedureI'm not sure what that means. I don't know enough about VB to know what's wrong or how to set it up. If you can see the problem, please let me know. I've got a workbook with 80 sheets in it and this macro could really save me a lot of time. I'm grateful for your help.

Here's the full script:

Sub Transpose_3D_to_2D() ' ' Transpose_3D_to_2D Macro ' Transpose 3D cell reference ' Option Explicit Private Sub ThreeDToTwoD() Dim rngCell As Range Dim strFmlaAddr As String Dim strFormula As String Dim strFunc As String Dim strSheets As String Dim strFirstSht As String Dim strLastSht As String Dim strCells As String Dim intRow As Integer Dim n As Integer On Error GoTo ErrHnd For Each rngCell In Selection 'only test cells with a formula and a worksheet name (has ! in formula) If rngCell.HasFormula = True And InStr(1, rngCell.Formula, "!") > 0 Then 'get 3D formula and get its component parts strFormula = Right(rngCell.Formula, Len(rngCell.Formula) - 1) strFunc = Left(strFormula, InStr(1, strFormula, "(")) strSheets = Mid(strFormula, InStr(1, strFormula, "(") + 1, _ InStr(1, strFormula, "!") - InStr(1, strFormula, "(") - 1) strFirstSht = Left(strSheets, InStr(1, strSheets, ":") - 1) strLastSht = Right(strSheets, Len(strSheets) - InStr(1, strSheets, ":")) strCells = Right(strFormula, Len(strFormula) - InStr(1, strFormula, "!")) 'set first row offset for new 2D formulas intRow = 1 'loop through all the worksheet names in the 3D range For n = Worksheets(strFirstSht).Index To Worksheets(strLastSht).Index 'create 2D formulas below 3D formula rngCell.Offset(intRow, 0).Formula = _ "=" & strFunc & Worksheets(n).Name & "!" & strCells 'next row intRow = intRow + 1 Next n End If Next rngCell Exit Sub 'error handler ErrHnd: Err.Clear MsgBox rngCell.Address End Sub

Hi, You have wrapped the sub routine I posted inside another sub.

Sub Transpose_3D_to_2D() ' ' Transpose_3D_to_2D Macro ' Transpose 3D cell reference ' Option Explicit Private Sub ThreeDToTwoD() Dim rngCell As Range

There is your new sub - Sub Transpose_3D_to_2D(),

which is OK, but you now have another line starting a sub - Private Sub ThreeDToTwoD()So delete the second sub line.

The error you are getting is because Option Explicit is inside a subroutine - This statement must be before any subroutine.

So move it above Sub Transpose_3D_to_2D()

You will see that the box above the code will change to (Declarations) when you are above the first Sub. This is where Option Explicit goes (not in the box but in the VB window before the first Sub line)Regards

Hi,

Here are some notes on Macros - I see that you have started, so you have done some of this already).Assuming that your need to convert 3D references to 2D applies to one particular worksheet, I suggest saving this macro as part of that workbook. For this guide, I shall call your workbook ThreeD.

Open ThreeD. Save it as a Macro enabled worksheet (I think it will get an xlsm extension - I do not have Excel 2007 on this PC). Now Click Alt+f11 (The Alt key and function key #11 pressed at the same time). This opens up a the Visual Basic Window.

On the left there should be an explorer pane - if it's not visible, from the menu bar select View and then Project Explorer.

Look in the Explorer pane for VBAProject(ThreeD.xlsm). Right-Click on Microsoft Excel Objects under ThreeD.xlsm - if not visible click on the + sign to expand. Select Insert and Module (not Class module). There will now be a new sub-item - Modules, containing Module1. Double click on Module1.

The pane on the right will be empty apart from two boxes at the top containing (General) and (Declarations).

Paste the code into this window.

The code will be colored - but none of it should be red, which denotes a fatal error in the code!From the visual basic window select File- Save, to ensure that the new code is saved.

You can use Alt+f11 to swap back and forth between the main Excel window and the visual basic window.

Back in your ThreeD workbook, select a cell or cells containing 3D references. Alt+f11 back to the VB window. Put the cursor in the code either on the line Private Sub ThreeDToTwoD() or on any line following it. Click on f5 (function key #5) and the code will run.

Instead of using f5 you can use f8 and this single steps through the code. The next line of code to run is highlighted in yellow. When single stepping, if you hover the mouse of variables, you will see their value. This works for some formulas - try moving the mouse over the code.

You can also use the Watch window.

In the code select rngCell, right-click and Add Watch...

In the dialog box add ".Address" to the rngCell shown at the top. Click OK and rngCell.Address will be added to a new Watch window.

As the code loops through the cells in your original selection, the watch window will display the address of each cell - as the code uses the For Each rngCell in Selection.

To see the Value of each cell, change the watch to rngCell.Value or rngCell.Formula to see the formulas in each cell.Hope this gives you a start on using Macros.

Regards

Hi, Thank you again.

I removed the second sub line and it is not hanging. However, something is still wrong.

It runs now, but opens a small error handing window (I think) that gives the cell reference that the macro started on, in this case $D$2 and an OK button. I click the okay button and nothing happens.

What should happen?

I'm not referring to any external worksheets.

I'm running the macro on a sum() formula.

The sum() formula is looking at a 3D reference to a cell that contains a VLOOKUP reference to another sheet in the workbook (that is outside the range of the 3D reference).

Hi, Can you post the formula in D2.

The pop-up box is because the macro is returning an error.

Regards

It kept failing so I decided to try it on another, new workbook with a very simple formula. That worked perfectly. Apparently, the formula on the sheets was too complicated.

The formula I used (that failed) was this:

=(IF(Q19<>0,((VLOOKUP(Q19,Labor!$B$3:$C$8,2))*P19),0))I created a 3D Sum equation referring to 81 sheets containing this formula. The formula itself returned a dollar-formatted value. The macro failed on the loop at the bottom. Stepping through using F8, it got to the following line:

For n = Worksheets(strFirstSht).Index To Worksheets(strLastSht).IndexThen jumped straight to this line:

Err.ClearDo you see why my formula might be causing the macro to fail?

Hi, As the formula you posted is not a 3D formula there are no sheets for the macro to loop through. Hence there is no first or last sheet and the line will fail, and jump to the error handler. If you hover the mouse over strFirstSht and strLastSht you will likely get "", i.e., no worksheet name, so its Index number cannot be returned.

The macro was only designed to work on simple 3D formulas. As I noted in Response #1: I have only tested this with the SUM() function, but it should work on other simple functions with the same formula structure.

So it should work for SUM(SheetA:SheetX!A1:A10) and other similarly structured formulas. I tried a few others such as COUNTA and AVERAGE and they were OK.

If you have a specific 3D formula that you would like it to work on, I can probably write the necessary code.

Also avoid selecting cells with non-3D formulas, as the code was not designed to exclude them.

Regards

Hi,

I've been out of town since last week. Just got back.Actually, the formula I was referring to is a 3D formula. It's this:

=SUM('2.1.1:Sheet1'!R34)

In my earlier post, I meant that the formula in the sheet titled "2.1.1" and in all the sheets in the R34 cell was:=(IF(Q19<>0,((VLOOKUP(Q19,Labor!$B$3:$C$8,2))*P19),0))That second formula gave an amount in dollars , and the 3D sum of all those formulas was:

$3,884,470.00I was trying to break out the individual amounts that make up the sum.

This was for an assignment in school. The assignment is past due now and I solved the problem another way (without a macro) but I'm still interested in a solution, because this is a powerful technique I'd like to master. However, I don't want to take up any more of your time. You've been most generous. Thank you.

Ask Your Question

Weekly Poll