fixing formulas that are off by 4 rows

Topic

New Reply

Hi

I have an Excel2010 file with master data sheet “Stock” (headings in row1, 20 data columns, ~3000 rows)
The file has ~1000 worksheets, each of which has many formulas that ‘point’ to the “Stock” sheet.
These formulas are pointing to the correct columns on the “Stock” sheet, but the rows are off by 4.
So, for example, on one of the sheets I might have
=Stock!D841
..but it should actually be
=Stock!D845
and
=Stock!B888 should actually be =Stock!B892 etc etc etc.

Is there an easy way to process and update each sheet to ‘fix’ these formulas?

zeddy

Reply | Quote

Replies

But I suspect you were looking for a way outside of VBA

Code:

Public Sub CorrectFormula()
[COLOR=”#008000″]’—————————
‘DECLARE AND SET VARIABLES[/COLOR]
Dim cf As String, A As Integer
Dim rng As Range, cell As Range
[COLOR=”#008000″]’—————————
‘CYCLE THROUG SHEETS EXCEPT SHEET 1 (STOCK)[/COLOR]
For I = 2 To Worksheets.Count
    Set rng = Worksheets(I).UsedRange
[COLOR=”#008000″]’—————————
‘CYCLE THROUGH CELLS WITH FORMULAS[/COLOR]
    For Each cell In rng
        If cell.HasFormula Then
            cf = cell.Formula
            s = Split(cf, “!”)
            If s(0) = “=Stock” Then
[COLOR=”#008000″]’—————————
‘FIND ROW NUMBER IN FORMULA AND INCREMENT BY 4[/COLOR]
                For J = 1 To Len(s(1))
                    If IsNumeric(Mid(s(1), J, 1)) Then Exit For
                Next J
                Str1 = Mid(s(1), 1, J – 1)
                Str2 = Val(Mid(s(1), J, Len(s(1)) – Len(Str1))) + 4
                x = s(0) & “!” & Str1 & Str2
            End If
        End If
        cell.Formula = x
    Next cell
Next I
End Sub

Maud

Reply | Quote

Zeddy,

Easy…not likely AFAICT!

However, here’s a start on a macro. As written this will only work on simple cell references but it does demonstrate the process. I also made it only work on the selection just to limit things that of course can be easily be changed to the active range and to loop through the worksheets in the workbook. 1000 Sheets REALLY!

The hard work of course, yet to be done and I’m sure you’re up to the task, is tearing apart formulas and adjusting each reference!

Reference Sheet (Your Stock Sheet)
44481-zeddyReference

One of your 1000
44482-zeddybefore

The code:

Code:

Option Explicit

Sub AdjRefs()

   Dim Cell     As Range
   Dim zFormula As String
   Dim vParts   As Variant
   Dim zAddr    As String
   
   For Each Cell In Selection
      zFormula = Cell.Formula
      vParts = Split(zFormula, "!")
      zAddr = Range(vParts(1)).Offset(4, 0).Address(False, False, xlA1)
      Cell.Formula = vParts(0) & "!" & zAddr
   Next Cell
   
End Sub

Result:
44483-zeddyafter

Test File: 44484-ZeddyChgFormulas-RG1

HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Ah…using .Offset. Brilliant!!!

Reply | Quote

Zeddy,

Just had another thought…WOW two in one day!

You could insert a HelperSheet which pushes everything down by 4 rows then do a global search & replace for Stock! to HelperSheet!.

Then every time Stock updates just copy it to HelperSheet, via Macro of course. Or you could set HelperSheet to just be references to Stock starting in HelperSheet!A5 with formula =Stock!A1 copy across then down.

HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Hi RG & Maud

Easy…not likely AFAICT!

It was RG who reminded me of the best method, which I had forgotten.
(and a well deserved extra Thank You for that, see above)
The fix took almost 2 seconds to achieve, without any vba coding.

1. Insert a new sheet and name as zzzz (time taken: 1 second)
2. Use Ctrl-H to do a workbook global replace of Stock! for zzzz! (time taken: almost immediate)
3. On sheet [zzzz], insert 4 rows at top of the sheet. (time taken: almost immediate)
4. Use Ctrl-H to do a workbook global replace of zzzz! for Stock! (time taken: almost immediate)
5. Delete sheet [zzzz]

All formulas on all sheets have now been automatically adjusted to the correct references (including formulas with multiple references).

It’s a long time since I had to fix ‘structure’ defects like this.
The method could also be used to sort out column references that are ‘out of sync’ etc.

Many thanks for the coding examples too. Always good to look at other techniques and methods.

zeddy

Reply | Quote

Zeddy,

I’m on a roll!

Here’s a new version that will handle more than one reference in a formula and handle ranges like in SUMs. Not sure this will handle everything but it’s a step in the right direction.

Code:

Option Explicit

Sub AdjRefs()

   Dim Cell     As Range
   Dim zFormula As String
   Dim vParts   As Variant
   Dim zAddr    As String
   
   For Each Cell In Selection
      zFormula = Cell.Formula
      vParts = Split(zFormula, "!")
      zAddr = Range(vParts(1)).Offset(4, 0).Address(False, False, xlA1)
      Cell.Formula = vParts(0) & "!" & zAddr
   Next Cell
   
End Sub



Sub MultiRefs()

   Dim iStart   As Integer
   Dim iEnd     As Integer
   Dim zFormula As String
   Dim lNewRef  As Long
   Dim Cell     As Range
   Dim lRowOffs As Long

   lRowOffs = 4    'Number of rows to offset formulas
   
   For Each Cell In Selection
   
      iStart = 1
      iEnd = 0
      zFormula = Cell.FormulaR1C1
      iStart = InStr(iStart, zFormula, "Sheet1!R[")
      
      If (iStart = 0) Then  '*** If no reference move to next cell ***
        GoTo NothingToProcess
      Else
        iStart = iStart + Len("Sheet1!R[")
      End If
      
 Debug.Print "Start: " & zFormula

      Do While iStart > iEnd
        iEnd = InStr(iStart, zFormula, "]")
        lNewRef = Val(Mid(zFormula, iStart, iEnd - iStart))
        lNewRef = lNewRef + IIf(lNewRef  0) Then   '*** ONLY process if range found ***
        iStart = iStart + Len(":R[")

        Do While iStart > iEnd
          iEnd = InStr(iStart, zFormula, "]")
          lNewRef = Val(Mid(zFormula, iStart, iEnd - iStart))
          lNewRef = lNewRef + IIf(lNewRef < 0, lRowOffs, lRowOffs * -1)
          zFormula = Left(zFormula, iStart - 1) & lNewRef & Right(zFormula, Len(zFormula) - (iEnd - 1))
          iStart = InStr(iStart, zFormula, ":R[") + Len(":R[")
        Loop
        
      End If
      
 Debug.Print "Ending:" & zFormula
   
      Cell.FormulaR1C1 = zFormula
      
NothingToProcess:

   Next Cell
   
End Sub   'MultiRefs()

Columns added for range test:
44488-ColumnsAdded
Before:
44485-zeddybefore

After:
44486-zeddyafter

Changes made:

Code:

Start: =CONCATENATE(Sheet1!R[-6]C,Sheet1!R[-6]C[3])
Ending:=CONCATENATE(Sheet1!R[-2]C,Sheet1!R[-2]C[3])
Start: =CONCATENATE(Sheet1!R[-6]C,Sheet1!R[-6]C[3])
Ending:=CONCATENATE(Sheet1!R[-2]C,Sheet1!R[-2]C[3])
Start: =CONCATENATE(Sheet1!R[-6]C,Sheet1!R[-6]C[3])
Ending:=CONCATENATE(Sheet1!R[-2]C,Sheet1!R[-2]C[3])
Start: =CONCATENATE(Sheet1!R[-6]C,Sheet1!R[-6]C[3])
Ending:=CONCATENATE(Sheet1!R[-2]C,Sheet1!R[-2]C[3])
Start: =CONCATENATE(Sheet1!R[-6]C,Sheet1!R[-6]C[3])
Ending:=CONCATENATE(Sheet1!R[-2]C,Sheet1!R[-2]C[3])
Start: =SUM(Sheet1!R[-7]C[8]:R[-7]C[12])
Ending:=SUM(Sheet1!R[-3]C[8]:R[-3]C[12])
Start: =SUM(Sheet1!R[-7]C[8]:R[-7]C[12])
Ending:=SUM(Sheet1!R[-3]C[8]:R[-3]C[12])
Start: =SUM(Sheet1!R[-7]C[8]:R[-7]C[12])
Ending:=SUM(Sheet1!R[-3]C[8]:R[-3]C[12])

Test File: 44487-ZeddyChgFormulas-RG2

HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Maud,

I missed your initial post completely!
42088-HeadBang

In my defense you posted while I was coding and then I just posted.
And then of course I didn’t look backward when reposting…
44372-HomerDOH

Sure wish I’d seen it sooner would have saved me several hours!

Oh well, I learned something in the process so not all is lost!

:cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Hi Maud and RG

Thanks very much to both of you.
I am currently digesting.
And after I’ve eaten, I’m watching a film.
I will report back tomorrow with what I did.

(1000+ sheets? Yup, not one of MY files)

zeddy

Reply | Quote