在多个工作表中更新外部单元格引用（使用vba宏）

Question

I'm completely new to VBA and Excel macros in general so I'll try to explain my predicament as clearly as possible. Basically I've got two workbooks, the source workbook which contains a single worksheet with nearly thousands of rows and columns and another workbook with 90+ worksheets, each with two tables that references cells from the source workbook (the tables cover monthly data for the last four fiscal years).

I've shoe-stringed together an automation macro that mostly works, but my primary concern is that it could be done better, specifically I've got one section of code:

'October
cellVarO = ActiveSheet.Range("B8").Formula
cellVarO = Right(cellVarO, 5)
Range("B8").Select
ActiveCell.Formula = "=OFFSET('C:\external\[reference_sheet.xls]Mnthly Rdgs'!" & cellVarO & ",0," & fyNum * 12 & ")"

One thing to note is that this code repeats 24 times, one for each month, and another iteration to use MID so that I'm still selecting the right cell value from the active cell formula (after changing the original formula to include OFFSET). I find this bulky and unnecessary but it's the only way I can wrap my mind around the problem. Another issue, it considers that the cell reference will always be 5 characters long. There are instances where this is not the case.

But basically my months are laid out by column and my years are laid out by row, what I was aiming to do here was look in the cell formula for the cell reference, select the cell value, then use OFFSET to shift the value 12 columns to the most recent one, and print the new value to the most recent year. Suppose if I have the cell formula:

='C:\external\[reference_sheet.xls]Mnthly Rdgs'!QR938

My goal is to take the cell value here (QR938) and shift it right 12 columns. Is there any way to pick out the cell value (other than using MID/RIGHT) and assign it to a variable to offset? Is there a better way to shift the cell value 12 columns other than using OFFSET? Finally, is there any way to perform that same operation across multiple similarly formatted worksheets?

Answer 1

See if this helps

For testing the main code:

Sub Tester()

    'offset 12 cols to right
    OffsetFormulaReference ActiveSheet.Range("B8"), 0, 12

    'offset 12 cols to left
    OffsetFormulaReference ActiveSheet.Range("B9"), 0, -12

    'offset 12 rows down
    OffsetFormulaReference ActiveSheet.Range("B10"), 12, 0

    'offset 12 rows up
    OffsetFormulaReference ActiveSheet.Range("B11"), -12, 0


    'EDIT: loop over sheets and edit a specific range
    Dim c As Range, sht as WorkSheet
    For Each sht in ThisWorkbook.Sheets
        For each c in sht.Range("B8:B20").Cells
            OffsetFormulaReference c, 12, 0
        Next c
    Next sht

End Sub

Utility method for taking the formula from a cell with an external reference and moving it over by the specified number of rows/columns:

Sub OffsetFormulaReference(c As Range, offsetRows, offsetCols)

    Dim origForm As String, origAddr As String
    Dim arr, rng As Range, newAddr As String

    If c.HasFormula Then
        origForm = c.Formula
        '(e.g.)  ='C:\external\[reference_sheet.xls]Mnthly Rdgs'!QR938

        If InStr(origForm, "!") > 0 Then

            arr = Split(origForm, "!") 'arr(1) = "QR938"
            Set rng = ActiveSheet.Range(arr(1)) 'get a range reference
            Set rng = rng.Offset(offsetRows, offsetCols) 'move the reference
            newAddr = rng.Address(False, False) 'get the offset address
            'replace old formula with new offset reference
            c.Formula = arr(0) & "!" & newAddr
        End If
    End If
End Sub

Note: you'll get an error if you try to use Offset() to move the rng reference beyond the limits of the sheet (eg. row or column < 1). You can add logic to handle that if it might be an issue.