Paste a formula with an external reference from $a$1 to $a$5 but only increment the cell reference from ...!$I$64 to $J$64

Question

I am trying to setup a spreadsheet that will pull monthly values from an external sheet.   The linking of the values into the spreadsheet is straight forward, however I'd like to avoid re-entering the formula into each cell manually.  The catch is the source cells are adjacent i.e. $h$64, $I$64, etc. However the target sheet has 5 additional columns between each destination cell.  When I paste the formula into the next target cell is increments from $h$64 to $M$64.  I want the formula to increment by 1 to $i$64.  Can this be done??? Thanks!

Answer 1

Thank you Andreas I will try this asap!

Answer 2

When I paste the formula into the next target cell is increments from $h$64 to $M$64.  I want the formula to increment by 1 to $i$64.  Can this be done???

No, but we can shift the formulas afterwards with a macro.

Copy the code below my name into a normal module.

Be sure you have a copy of your workbook, the changes can't be undo!

Select all formulas that should be shifted, including those that refers $N$64, $O$65 etc.

Execute the macro.

Enter the string "M-I" (without the "") if the Inputbox appears.

Note: All formulas are changed to absolute style, means "=M64" is "=$I$64" afterwards.

Andreas.

Option Explicit

Sub ShiftFormula_Selection()

  Dim R As Range, All As Range

  Dim Shift As Variant, Part As Variant

  Dim RO As Long, CO As Long

  Dim i As Long, j As Long

  Dim Plus As Boolean

  On Error Resume Next

  'Remove unused cells from the selection

  Set All = Intersect(Selection, ActiveSheet.UsedRange)

  'We need formulas only

  Set All = Intersect(All, All.SpecialCells(xlCellTypeFormulas))

  'Install an error handler

  On Error GoTo ErrorHandler

  'Cells with formulas found?

  If All Is Nothing Then

    Err.Raise 1001, "ShiftFormula_Selection", _

      "Select cells with formulas and try again"

  End If

  'Show them

  All.Select

  'Ask the user for the shift

  Shift = InputBox("Syntax: " & vbNewLine & _

    "  R+1 C-1  means 1 row down and 1 column left" & vbNewLine & _

    "or" & vbNewLine & _

    "  4-2 A-C  means 2 rows up and 2 columns right", _

    "ShiftFormula_Selection")

  'Abort?

  Shift = Trim$(Shift)

  Do While InStr(Shift, "  ") > 0

    Shift = Replace(Shift, "  ", " ")

  Loop

  If Shift = "" Then Exit Sub

  'Parse the input

  Shift = Split(UCase(Shift), " ")

  For i = 0 To UBound(Shift)

    Plus = InStr(Shift(i), "+") > 0

    Part = Split(Shift(i), IIf(Plus, "+", "-"))

    If UBound(Part) <> 1 Then

      Err.Raise 1002, "ShiftFormula_Selection", _

        "Syntax error"

    End If

    If IsNumeric(Part(1)) Then

      If IsNumeric(Part(0)) Then

        'row ± row

        RO = CLng(Part(1)) - CLng(Part(0))

        If Plus Then RO = RO * -1

      Else

        'row/column ± number

        Select Case Trim$(Part(0))

          Case "R"

            RO = -CLng(Part(1))

            If Plus Then RO = RO * -1

          Case "C"

            CO = -CLng(Part(1))

            If Plus Then CO = CO * -1

          Case Else

            Err.Raise 1003, "ShiftFormula_Selection", _

              "Syntax error"

        End Select

      End If

    Else

      'column ± column

      CO = Columns(Part(1)).Column - Columns(Part(0)).Column

      If Plus Then CO = CO * -1

    End If

  Next

  'Something to do?

  If RO = 0 And CO = 0 Then Exit Sub

  'Shift the formulas

  ShiftFormula All, RO, CO, xlAbsolute

  Exit Sub

ErrorHandler:

  If Err.Source = "" Then Err.Source = Application.Name

  Debug.Print "Source     : " & Err.Source

  Debug.Print "Error      : " & Err.Number

  Debug.Print "Description: " & Err.Description

  If MsgBox("Error " & Err.Number & ": " & vbNewLine & vbNewLine & _

      Err.Description & vbNewLine & vbNewLine & _

      "Enter debug mode?", vbOKCancel + vbDefaultButton2, Err.Source) = vbOK Then

    Stop 'Press F8 twice

    Resume

  End If

End Sub

Sub ShiftFormula(ByVal R As Range, _

    Optional ByVal RowOffset As Long, Optional ByVal ColumnOffset As Long, _

    Optional ByVal RefType As XlReferenceType = xlRelative)

  'Moves the cell reference in any formula in the given range by an offset

  Dim C As Range, S As String

  'Ignore cells with values

  On Error Resume Next

  Set R = Intersect(R, R.SpecialCells(xlCellTypeFormulas))

  If R Is Nothing Then Exit Sub

  'Create a reference for the shift

  Set C = R.Parent.Cells(1, 1)

  If RowOffset < 0 Then Set C = C.Offset(-RowOffset)

  If ColumnOffset < 0 Then Set C = C.Offset(, -ColumnOffset)

  'Visit each cell

  For Each R In R

    If R.HasArray Then

      If R.CurrentArray.Cells(1, 1).Address = R.Address Then

        'Convert the formula to relativ style

        S = Application.ConvertFormula(R.FormulaArray, xlA1, xlR1C1, xlRelative, C)

        'Offset the formula to the given style

        R.FormulaArray = Application.ConvertFormula(S, xlR1C1, xlA1, RefType, _

          C.Offset(RowOffset, ColumnOffset))

      End If

    Else

      S = Application.ConvertFormula(R.Formula, xlA1, xlR1C1, xlRelative, C)

      R.Formula = Application.ConvertFormula(S, xlR1C1, xlA1, RefType, _

        C.Offset(RowOffset, ColumnOffset))

    End If

  Next

End Sub