Updating a value in formulas using vba

Microsoft Office excel 2007 home & stude...
July 24, 2010 at 00:19:03
Specs: Windows XP
I have a slight problem. I have a workbook that has formulas on every worksheet. The problem is that my formulas have dates in them to correspond to fiscal years. For example:

=IF(TODAY()>=DATEVALUE("9/1/2010"),SEPFY10!E2+D12,"")

I need to be able to use vba to update the ("9/1/2010") to ("9/1/2011") once the fiscal year is over. I need to do that for every formula. Any help I can get would be greatly appreciated.


See More: Updating a value in formulas using vba

Report •


#1
July 24, 2010 at 05:35:29
Hi,

I note that the formula you posted includes a reference to a worksheet that is also named according to the fiscal year "SEPFY10"

For this to work effectively you will need the new FY worksheets, otherwise every formula that changes will cause an 'Open file' dialog box to open, asking you to find the Workbook with the new worksheet name.

The formula you posted becomes:
=IF(TODAY()>=DATEVALUE("9/1/2011"),SEPFY11!E2+D12,"")

so you need a SEPFY11 worksheet

The following VBA macro will first find all worksheets containing either the full year e.g. 2010 or FY10 and make a copy of it, renaming it with the new year.
Your workbook will now have a SEPFY10 and a SEPFY11

Then the formulas are all changed, and you should not get any 'Open file' dialog boxes, as the formulas reference valid worksheets.

Option Explicit

Public Sub changeFY()
Dim strWB As String
Dim strOldFY As String
Dim strNewFY As String
Dim strWSOld As String
Dim strWSNew As String
Dim strWSname As String
Dim strFmla As String
Dim ws As Worksheet
Dim cl As Range

On Error GoTo ErrHnd

'get workbook name
strWB = InputBox("Enter full workbook name - including extension", _
        "Update Fiscal Year Workbook")

EnterFY:
'get this FY
strOldFY = InputBox("Enter year or 'Quit' to exit", _
        "Enter Last Fiscal Year")
'if "Quit" is entered - exit sub
If strOldFY = "Quit" Then Exit Sub
'get new FY
strNewFY = InputBox("Enter year or 'Quit' to exit", _
        "Enter New Fiscal Year")
'if "Quit" is entered - exit sub
If strNewFY = "Quit" Then Exit Sub

'check FY is only 4 characters and is a number
If (Not IsNumeric(strOldFY)) Or Len(strOldFY) <> 4 _
    Or (Not IsNumeric(strOldFY)) Or Len(strOldFY) <> 4 _
    Then GoTo EnterFY

'create FY text strings for worksheet names
strWSOld = "FY" & Right(strOldFY, 2)
strWSNew = "FY" & Right(strNewFY, 2)

'loop through all worksheets and create new year worksheets
For Each ws In Workbooks(strWB).Worksheets()
    'if worksheet name contains FY, copy it and change name
    If InStr(1, ws.Name, strOldFY) <> 0 Or _
            InStr(1, ws.Name, strWSOld) <> 0 Then
        'create new worksheet name
        strWSname = ws.Name
        'replace year in dates
        strWSname = Replace(strWSname, strOldFY, strNewFY, 1)
        'replace Worksheet FY text
        strWSname = Replace(strWSname, strWSOld, strWSNew, 1)
        'copy worksheet
        ws.Copy After:=ActiveWorkbook.Worksheets(Worksheets.Count)
        'rename it
        Worksheets(Worksheets.Count).Name = strWSname
    End If
Next ws

'loop through all worksheets to change formulas
For Each ws In Workbooks(strWB).Worksheets()
    'loop through all cells in 'Used Range' in each worksheet
    For Each cl In ws.UsedRange.Cells
        'look in formulas
        If cl.HasFormula = True Then
            'test if formula contains FY year or FY worksheet
            If InStr(1, cl.Formula, strOldFY) <> 0 Or _
                InStr(1, cl.Formula, strWSOld) <> 0 Then
                'copy/change/replace so that mixed formulas
                'that cause errors are avoided
                strFmla = cl.Formula
                'replace year in dates
                strFmla = Replace(strFmla, strOldFY, strNewFY, 1)
                'replace Worksheet references
                strFmla = Replace(strFmla, strWSOld, strWSNew, 1)
                'replace with new formula
                cl.Formula = strFmla
            End If
        End If
    Next cl
Next ws
Exit Sub

'error handler
ErrHnd:
Err.Clear
MsgBox "There was an error running this macro"
End Sub

Please note that changes made by macros cannot be undone with the undo function.
As this macro searches and potentially changes every formula in the workbook it is essential that:
a) this is tested extensively on copies of your workbooks and
b) You always make a backup copy of the workbook before using this macro on real data.
I suggest that this macro is not stored in the FY workbook, but in another location, perhaps a workbook that is only available to you or a trusted member of staff

The macro asks for the name of the workbook to change, and the workbook must already be open. This reduces the risk of the macro operating on the wrong workbook - if the required workbook was not the active workbook at the time it was run.

I have only tested this macro on very limited data and it has not been tested in your environment with your data/formulas - you have been warned :)

Regards


Report •

#2
July 24, 2010 at 10:38:02
I am getting ready to try it out. I really appreciate the quick response, as I am working on this over the weekend.

Report •

#3
July 24, 2010 at 11:23:18
Hey, it works great. The only thing that isn't really working is that our fiscal years run from October to September, so the code doen't change the formulas for the first three months of the fiscal year. The FY10 months of October, November and December are in the formulas as 10/1/2009, 11/1/2009, and 12/1/2009. I apologize, as I definitely should have mentioned that. I really appreciate the help.

Report •

Related Solutions

#4
July 24, 2010 at 12:27:42
Hi,

Conceptually I am running the 2010 to 2011 conversions first, then repeating the same code to convert 2009 to 2010.
This applies for both 4 digit years 2009 and 2010 and worksheet names e.g., OCTFY09 and SEPFY10

Here are two before and after formulas:
=IF(TODAY()>=DATEVALUE("9/1/2009"),OCTFY09!E2+D12,"")
=IF(TODAY()>=DATEVALUE("9/1/2010"),OCTFY10!E2+D12,"")
and
=IF(TODAY()>=DATEVALUE("9/1/2010"),SEPFY10!E2+D12,"")
=IF(TODAY()>=DATEVALUE("9/1/2011"),SEPFY11!E2+D12,"X")

Again very limited testing ...

Here is the revised macro:

Option Explicit

Public Sub changeFY()
Dim strWB As String
Dim strOldFY As String
Dim strNewFY As String
Dim strWSOld As String
Dim strWSNew As String
Dim strPreOldFY As String
Dim strPreNewFY As String
Dim strWSPreOld As String
Dim strWsPreNew As String
Dim strWSname As String
Dim strFmla As String
Dim ws As Worksheet
Dim cl As Range

On Error GoTo ErrHnd

'get workbook name
strWB = InputBox("Enter full workbook name - including extension", _
        "Update Fiscal Year Workbook")

EnterFY:
'get this FY
strOldFY = InputBox("Enter year or 'Quit' to exit", _
        "Enter Last Fiscal Year")
'if "Quit" is entered - exit sub
If strOldFY = "Quit" Then Exit Sub
'get new FY
strNewFY = InputBox("Enter year or 'Quit' to exit", _
        "Enter New Fiscal Year")
'if "Quit" is entered - exit sub
If strNewFY = "Quit" Then Exit Sub

'check FY is only 4 characters and is a number
If (Not IsNumeric(strOldFY)) Or Len(strOldFY) <> 4 _
    Or (Not IsNumeric(strOldFY)) Or Len(strOldFY) <> 4 _
    Then GoTo EnterFY

'create FY text strings for worksheet names
strWSOld = "FY" & Right(strOldFY, 2)
strWSNew = "FY" & Right(strNewFY, 2)
'create last year
strPreOldFY = CStr(CInt(strOldFY) - 1)
strPreNewFY = strOldFY
strWSPreOld = "FY" & Right(strPreOldFY, 2)
strWsPreNew = "FY" & Right(strPreNewFY, 2)

'loop through all worksheets and create new year worksheets
For Each ws In Workbooks(strWB).Worksheets()
    'if worksheet name contains FY, copy it and change name
    If InStr(1, ws.Name, strOldFY) <> 0 Or _
            InStr(1, ws.Name, strWSOld) <> 0 Then
        'create new worksheet name
        strWSname = ws.Name
        'replace year in dates
        strWSname = Replace(strWSname, strOldFY, strNewFY, 1)
        'replace Worksheet FY text
        strWSname = Replace(strWSname, strWSOld, strWSNew, 1)
        'copy worksheet
        ws.Copy After:=ActiveWorkbook.Worksheets(Worksheets.Count)
        'rename it
        Worksheets(Worksheets.Count).Name = strWSname
    End If
Next ws
'do it again for the prior year worksheets
For Each ws In Workbooks(strWB).Worksheets()
    'if worksheet name contains prior FY, copy it and change name
    If InStr(1, ws.Name, strPreOldFY) <> 0 Or _
            InStr(1, ws.Name, strWSPreOld) <> 0 Then
        'create new worksheet name
        strWSname = ws.Name
        'replace year in dates
        strWSname = Replace(strWSname, strPreOldFY, strPreNewFY, 1)
        'replace Worksheet FY text
        strWSname = Replace(strWSname, strWSPreOld, strWsPreNew, 1)
        'copy worksheet
        ws.Copy After:=ActiveWorkbook.Worksheets(Worksheets.Count)
        'rename it
        Worksheets(Worksheets.Count).Name = strWSname
    End If
Next ws

'loop through all worksheets to change formulas
For Each ws In Workbooks(strWB).Worksheets()
    'loop through all cells in 'Used Range' in each worksheet
    For Each cl In ws.UsedRange.Cells
        'look in formulas
        If cl.HasFormula = True Then
            'test if formula contains FY year or FY worksheet
            If InStr(1, cl.Formula, strOldFY) <> 0 Or _
                InStr(1, cl.Formula, strWSOld) <> 0 Then
                'copy/change/replace so that mixed formulas
                'that cause errors are avoided
                strFmla = cl.Formula
                'replace year in dates
                strFmla = Replace(strFmla, strOldFY, strNewFY, 1)
                'replace Worksheet references
                strFmla = Replace(strFmla, strWSOld, strWSNew, 1)
                'replace with new formula
                cl.Formula = strFmla
            End If
        End If
    Next cl
Next ws
'do it again for the prior year formulas
For Each ws In Workbooks(strWB).Worksheets()
    'loop through all cells in 'Used Range' in each worksheet
    For Each cl In ws.UsedRange.Cells
        'look in formulas
        If cl.HasFormula = True Then
            'test if formula contains prior FY year or prior FY worksheet
            If InStr(1, cl.Formula, strPreOldFY) <> 0 Or _
                InStr(1, cl.Formula, strWSPreOld) <> 0 Then
                'copy/change/replace so that mixed formulas
                'that cause errors are avoided
                strFmla = cl.Formula
                'replace year in dates
                strFmla = Replace(strFmla, strPreOldFY, strPreNewFY, 1)
                'replace Worksheet references
                strFmla = Replace(strFmla, strWSPreOld, strWsPreNew, 1)
                'replace with new formula
                cl.Formula = strFmla
            End If
        End If
    Next cl
Next ws
Exit Sub
'error handler
ErrHnd:
Err.Clear
MsgBox "There was an error running this macro"
End Sub

Regards


Report •

#5
July 24, 2010 at 13:29:28
Thanks. I came up with something that works. Here is the code. Tell me what you think:

Public Sub changeFY()
Dim strWB As String
Dim strOldFY As String
Dim strNewFY As String
Dim strWSOld As String
Dim strWSNew As String
Dim strWSname As String
Dim strFmla As String
Dim ws As Worksheet
Dim cl As Range
Dim strOldFYMinusOne As String ' NEW LINE

On Error GoTo ErrHnd

'get workbook name
strWB = InputBox("Enter full workbook name - including extension", _
"Update Fiscal Year Workbook")

EnterFY:
'get this FY
strOldFY = InputBox("Enter year or 'Quit' to exit", _
"Enter Last Fiscal Year")
strOldFYMinusOne = strOldFY - 1 'NEW LINE
'if "Quit" is entered - exit sub
If strOldFY = "Quit" Then Exit Sub
'get new FY
strNewFY = InputBox("Enter year or 'Quit' to exit", _
"Enter New Fiscal Year")
'if "Quit" is entered - exit sub
If strNewFY = "Quit" Then Exit Sub

'check FY is only 4 characters and is a number
If (Not IsNumeric(strOldFY)) Or Len(strOldFY) <> 4 _
Or (Not IsNumeric(strOldFY)) Or Len(strOldFY) <> 4 _
Then GoTo EnterFY

'create FY text strings for worksheet names
strWSOld = "FY" & Right(strOldFY, 2)
strWSNew = "FY" & Right(strNewFY, 2)

'loop through all worksheets and create new year worksheets
For Each ws In Workbooks(strWB).Worksheets()
'if worksheet name contains FY, copy it and change name
If InStr(1, ws.Name, strOldFY) <> 0 Or _
InStr(1, ws.Name, strWSOld) <> 0 Then
'create new worksheet name
strWSname = ws.Name
'replace year in dates
strWSname = Replace(strWSname, strOldFY, strNewFY, 1)
'replace Worksheet FY text
strWSname = Replace(strWSname, strWSOld, strWSNew, 1)
'copy worksheet
ws.Copy After:=ActiveWorkbook.Worksheets(Worksheets.Count)
'rename it
Worksheets(Worksheets.Count).Name = strWSname
End If
Next ws

'loop through all worksheets to change formulas
For Each ws In Workbooks(strWB).Worksheets()
'loop through all cells in 'Used Range' in each worksheet
For Each cl In ws.UsedRange.Cells
'look in formulas
If cl.HasFormula = True Then
'test if formula contains FY year or FY worksheet
If InStr(1, cl.Formula, strOldFY) <> 0 Or _
InStr(1, cl.Formula, strWSOld) <> 0 Or _
InStr(1, cl.Formula, strOldFYMinusOne) <> 0 Then
'copy/change/replace so that mixed formulas
'that cause errors are avoided
strFmla = cl.Formula
'replace year in dates
strFmla = Replace(strFmla, strOldFY, strNewFY, 1)
strFmla = Replace(strFmla, strOldFYMinusOne, strOldFY, 1) 'NEW LINE
'replace Worksheet references
strFmla = Replace(strFmla, strWSOld, strWSNew, 1)
'replace with new formula
cl.Formula = strFmla
End If
End If
Next cl
Next ws
Exit Sub

'error handler
ErrHnd:
Err.Clear
MsgBox "There was an error running this macro"
End Sub


I designated the new lines with ' NEW LINE

Thanks again for everything


Report •

#6
July 25, 2010 at 04:27:20
Hi,

Yes that looks good.

I did a two-pass option - doing 2010 to 2011, then 2009 to 2010, but as each cell is only accessed once for both changes an all-in-one, as you have done, will work.

If you do the same sort of change manually using Find & Replace, you have to do two passes, and if you do the 2009-2010 first, then the 2009's get converted to 2011 during the second pass 2010 to 2011.

I did note your code for incrementing the year:
strOldFYMinusOne = strOldFY - 1
This shows how forgiving VBA is, compared to many other languages. as strOldFY is a text string, VBA has internally converted it to a number and added 1 and then converted the number to text for strOldFYMinusOne.

The technically correct way to do this is to convert the text string to a number, do the math and convert back, like this:
strOldFYMinusOne = Cstr(Cint(strOldFY) - 1)

Regards


Report •


Ask Question