Solved

Edit formulas in unopened Excel file using VBA

Posted on 2011-09-25
11
250 Views
Last Modified: 2012-05-12
Back in the spring I created a template to be used to collect data throughout the summer. Those files are starting to come in and I now realize there were a couple of formulas that needed to be modified. Is there any way to create something in VBA that will make the necessary changes in these files as they come in?

Here's an example for cell CJ2. All formulas are on the first sheet.

Current: =(IF(INDEX('Data Entry'!$Q:$Q,ROW($Q18))=0,"",IF(INDEX('Data Entry'!$Q:$Q,ROW($Q18))=0,"",INDEX('Data Entry'!$Q:$Q,ROW($Q18)))))

Should be: =(IF(INDEX('Data Entry'!$Q:$Q,ROW($Q18))="","",IF(INDEX('Data Entry'!$Q:$Q,ROW($Q18))="","",INDEX('Data Entry'!$Q:$Q,ROW($Q18)))))

NOTE: All formulas needing to be changed are in 2 columns and all will be copied down for about 50 rows.

There will be about a thousand of these files coming in. So, you can see my wish for having something somewhat automated.

Thanks, Dale
0
Comment
Question by:dlogan7
  • 4
  • 4
  • 2
  • +1
11 Comments
 
LVL 41

Expert Comment

by:dlmille
ID: 36596574
You'll need to open each excel file, in order to edit it.  Just create a loop to iterate through all the files (say, in a folder) open them (be sure to turn EnableEvents False, unless they are .xlsx files to ensure macros don't kick off), and change the formula, then save...

Here's an example...

See "MAKE CHANGES HERE" for where changes need to be made to customize your application.

Here's the code:  
 
Option Explicit
Sub loopAndChangeFormulas()
Dim fPath As String
Dim fName As String, fSaveAsFilePath As String, fOriginalFilePath As String
Dim wBook As Workbook, fFilesToProcess() As String
Dim numconverted As Long, cntToConvert As Long, i As Long
Dim killOnSave As Boolean, xMsg As Long, overWrite As Boolean, pOverWrite As Boolean
Dim silentMode As Boolean
Dim fileType As String
Dim sht As Worksheet
Dim rng As Range


    Application.DisplayAlerts = False 'no user prompting, taking all defaults
    Application.EnableEvents = False
    
    fileType = "*.xlsx" 'MAKE CHANGES HERE
        
    fPath = GetFolderName("Select Folder for formula change")
    
    If fPath = "" Then
        MsgBox "You didn't select a folder", vbCritical, "Aborting!"
        Exit Sub
    Else
        fName = Dir(fPath & "\" & fileType)
        If fName = "" Then
            MsgBox "There aren't any " & fileType & " files in the " & fPath & " directory", vbCritical, "Aborting"
            Exit Sub
        Else

            Do
                ReDim Preserve fFilesToProcess(cntToConvert) As String
                fFilesToProcess(cntToConvert) = fName
                cntToConvert = cntToConvert + 1
                
                fName = Dir
                
            Loop Until fName = ""
            
            For i = 0 To cntToConvert - 1
            
                Application.StatusBar = "Processing: " & i + 1 & " of " & cntToConvert & " file: " & fName
                
                fName = fFilesToProcess(i)
                
                'open and convert file
                On Error GoTo errHandler
                fOriginalFilePath = fPath & "\" & fName
                
                Set wBook = Application.Workbooks.Open(fOriginalFilePath)
                
                'get the range for formula conversion
                Set sht = wBook.Sheets("put your sheet name here") 'MAKE CHANGES HERE
                Set rng = sht.Range("put your range address here") 'MAKE CHANGES HERE to the first formula
                
                rng.Formula = "=the corrected formula" 'MAKE CHANGES HERE
                
                rng.Resize(50, 1).FillDown 'MAKE CHANGES HERE - this copies the formula starting at rng.address down for a total of 50 rows
                
                wBook.SaveAs Filename:=fSaveAsFilePath
                
                wBook.Close savechanges:=False
                numconverted = numconverted + 1
                    
            Next i
        End If
    End If
    
processComplete:
    On Error GoTo 0
    MsgBox "Completed formula conversions in " & numconverted & " files", vbOKOnly
    Application.EnableEvents = True 'uncomment if doing other conversions where macros are involved in source workbooks
    Application.StatusBar = False
    Application.DisplayAlerts = True
    Exit Sub
    
errHandler:
    Application.StatusBar = False
    MsgBox "For some reason, could not open/save the file: " & fPath & "\" & fName, vbCritical, "Aborting!"
    Resume processComplete
    
End Sub

Open in new window

See attached,

Hopefully, you can take it from here.  However, if you need more help, you'll need to provide sheet name and addresses where things need to be changed, etc., to be precise.

Dave
loopAndFixFormulas-r1.xlsm
0
 
LVL 80

Expert Comment

by:byundt
ID: 36596596
It would be better to open each of the files, make the modifications and then save the results. The following code opens every file in a user selected folder and makes the desired modifications. Install it in a regular module sheet.

Sub FormulaUpdater()
Dim rg As Range

'Replicate the next four lines as necessary
Set rg = ActiveSheet.Range("CJ2")
rg.Formula = "=(IF(INDEX('Data Entry'!$Q:$Q,ROW($Q18))="""","""",IF(INDEX('Data Entry'!$Q:$Q,ROW($Q18))="""","""",INDEX('Data Entry'!$Q:$Q,ROW($Q18)))))"
rg.Copy
Range(rg, rg.End(xlDown)).PasteSpecial xlPasteFormulas

End Sub


Sub LoopThroughWorkBooksInFolder()
'Runs a macro on every workbook in a user-specified folder
Dim ws As Worksheet
Dim wb As Workbook
Dim celHome As Range
Dim f As String, flPath As String
    'Change the default folder name in the following statement to a reasonable starting place
flPath = Application.GetSaveAsFilename( _
    "C:\", _
    Title:="Please pick any file in the desired folder, then click 'Save' button")
If flPath = "False" Then Exit Sub
Set celHome = ActiveCell
flPath = Left(flPath, InStrRev(flPath, "\"))

Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Application.EnableEvents = False    'Comment out if workbooks don't contain event macros
f = Dir(flPath & "*.xls")           'Make sure file extension matches
Do Until f = ""
    Set wb = Workbooks.Open(f)
    Application.StatusBar = "Processing " & wb.Name
    
    On Error Resume Next
    Set ws = Nothing
    Set ws = Worksheets("Sheet1")   'The worksheet that needs to be changed
    If Not ws Is Nothing Then
        ws.Activate
        FormulaUpdater
    End If
    
    wb.Close SaveChanges:=True
    f = Dir     'Get next filename & path
Loop

Errhandler:
    Application.GoTo celHome
    On Error GoTo 0
    'Application.EnableEvents = True     'Comment out if workbooks don't contain event macros
    Application.StatusBar = False
    Application.DisplayAlerts = True
End Sub

Open in new window

0
 
LVL 41

Expert Comment

by:dlmille
ID: 36596617
byundt - "It would be better..." Were you addressing me or the OP?

Dave
0
 
LVL 80

Expert Comment

by:byundt
ID: 36596622
Dale,
I see that my code to loop through files in a folder duplicates that of dlmille.

It is worth noting that the formulas you want to update include double-quotes. Since you must pass the new formula to the worksheet as text, you need to double up on each of the double-quotes contained in the formula. I did that for you in my FormulaUpdater sub. If you choose to modify Dave's macro for your updating, please be aware of this requirement.

Brad
0
 
LVL 41

Expert Comment

by:dlmille
ID: 36596629
byundt - FWIW - I like the formulaUpdater() routine you added - it is a nice compartmentalization.

Cheers,

Dave
0
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
LVL 80

Expert Comment

by:byundt
ID: 36596638
Dave,
My remarks were aimed at Dale.

I checked the thread several times for other posts, but didn't bother at the very end. Had I seen your Comment, I would have posted just my sub to modify the formulas. Your macro to loop through files in a folder is obviously battle-tested.

Brad
0
 
LVL 10

Expert Comment

by:broro183
ID: 36596888
hi everyone,

Here is a small change to the formulaUpdater code which removes the use of ".copy" & acts on the whole range in one go. I hope it is right...

Option Explicit

Sub FormulaUpdater_v2()
Dim rg As Range
Dim ws As Worksheet

    'RB: If possible I would try to modify the next line to state
    'the explicit workbook & sheet (perhaps supply them as parameters/arguments).
    Set ws = ActiveWorkbook.ActiveSheet

    'Replicate the next four lines as necessary
    With ws.Range("CJ2").Offset(0, 1)
        Set rg = ws.Range(.Cells(1, 1), .End(xlDown))
        'rg.Formula = "=(IF(INDEX('Data Entry'!$Q:$Q,ROW($Q18))="""","""",IF(INDEX('Data Entry'!$Q:$Q,ROW($Q18))="""","""",INDEX('Data Entry'!$Q:$Q,ROW($Q18)))))"
        rg.FormulaR1C1 = "=(IF(INDEX('Data Entry'!R1C17:R" & ws.Rows.Count & "C17,ROW(R[16]C17))="""","""",IF(INDEX('Data Entry'!R1C17:R" & ws.Rows.Count & "C17,ROW(R[16]C17))="""","""",INDEX('Data Entry'!R1C17:R" & ws.Rows.Count & "C17,ROW(R[16]C17)))))"
    End With
Set rg = Nothing
Set ws = Nothing
End Sub

Open in new window


Dale,
This formula seems to be the same on both sides of the IF statement (ie it has duplicated Index statements), or am I missing it something?
Should one of the tests be for "=0"?
If the files are large (or even if they are not), I would use a separate "helper column" to remove duplicated calculations for efficiency (see Charles Williams site: http://www.decisionmodels.com/optspeedb.htm). For example, assuming that the CK column is empty...

Sub FormulaUpdater_v3()
Dim rg As Range
Dim ws As Worksheet

    'RB: If possible I would try to modify the next line to state
    'the explicit workbook & sheet (perhaps supply them as parameters/arguments).
    Set ws = ActiveWorkbook.ActiveSheet

    'Replicate the next few lines as necessary
    With ws.Range("CJ2")
        Set rg = ws.Range(.Cells(1, 1), .End(xlDown))
    End With
    
    'the helper column formula in CK (note: I would normally make the flow of a spreadsheet's calculations
    'go from left to right but I'm putting this in CK to keep your
    'existing result in the CJ column and on the assumption that CK is empty).
    With rg
        .Offset(0, 1).FormulaR1C1 = "=INDEX('Data Entry'!C17,ROW(R[16]C17))"
        .FormulaR1C1 = "=(IF(RC[1]="""","""",IF(RC[1]="""","""",RC[1])))"
''or is it meant to be...?
        '.FormulaR1C1 = "=(IF(RC[1]="""","""",IF(RC[1]=0,0,RC[1])))"
    End With
    
    Set rg = Nothing
    Set ws = Nothing
End Sub

Open in new window


hth
Rob
0
 
LVL 10

Expert Comment

by:broro183
ID: 36596898
Ooopps!

I forgot to simplify my R1C1 code. The string in FormulaUpdater_v2 can be stated as:

        rg.FormulaR1C1 = "=(IF(INDEX('Data Entry'!C17,ROW(R[16]C17))="""","""",IF(INDEX('Data Entry'!C17,ROW(R[16]C17))="""","""",INDEX('Data Entry'!C17,ROW(R[16]C17)))))"

Open in new window

0
 

Author Comment

by:dlogan7
ID: 36597354
Dave,

That's awesome. I got it to work just fine. However, I want to point out that the first time I ran it I got an error message saying the file could not be saved. So, I changed 2 lines:

From this:
                wBook.SaveAs Filename:=fSaveAsFilePath
               
                wBook.Close savechanges:=False

To this:
               ' wBook.SaveAs Filename:=fSaveAsFilePath
               
                wBook.Close savechanges:=True

Question:

Some of these files may be: xls, xlxs, or xlsm. How can I modify this line to cover all of them?
    fileType = "*.xlsx" 'MAKE CHANGES HERE

Brad,

Thanks for catching the double quotes. I spend most of my time in Access and don't know a lot of the little tricks in Excel. Isn't there something else I can use to refer to a blank cell? I never understood why an Excel formula returns 0 when pointing to an empty cell.

Rob,

You are correct. There is some redundancy in that formula. Someone on EE helped me with that back in the spring. I have no idea what INDEX is doing. I must have modified it at some point and failed to realize what I had done. I will check out the link you provided.

Thanks, Dale
0
 
LVL 41

Accepted Solution

by:
dlmille earned 400 total points
ID: 36597437
Dale - sorry about that.  I had taken code I had been using (code that changed the filename) - my bad.  You made the right change, only needed:

wBook.Close SaveChanges:=True 'is exactly correct

----------------

>>Some of these files may be: xls, xlxs, or xlsm. How can I modify this line to cover all of them?
>> fileType = "*.xlsx" 'MAKE CHANGES HERE

fileType = "*.xls*" 'this should do the trick....

Glad it works for you, with the minor change you had to make :)

>>Isn't there something else I can use to refer to a blank cell?

Indeed, there is - you can use the reserved word vbNullString which equates to "".  Using byundit's formula and modifying, it would be:

rng.Formula = "=(IF(INDEX('Data Entry'!$Q:$Q,ROW($Q18))=" & vbNullString & "," & vbNullString & ",IF(INDEX('Data Entry'!$Q:$Q,ROW($Q18))=" & vbNullString & "," & vbNullString & ",INDEX('Data Entry'!$Q:$Q,ROW($Q18)))))"

I'm assuming you like the formulaUpdater routine, and left it to you to determine the code to use.  Here's a hybrid with the patches just discussed and the updater, using byundit's for demonstration purposes - I'm sure you're enhancing already:

The code:
 
Option Explicit
Sub formulaUpdater(wBook As Workbook, sht As Worksheet) 'kept wBook as it might be needed, per actual implementation
Dim rng As Range


    'get the range for formula conversion
    'Set sht = wBook.Sheets("put your sheet name here") 'MAKE CHANGES HERE
    'Set rng = sht.Range("put your range address here") 'MAKE CHANGES HERE to the first formula
    
    'rng.Formula = "=the corrected formula" 'MAKE CHANGES HERE
    
    'rng.Resize(50, 1).FillDown 'MAKE CHANGES HERE - this copies the formula starting at rng.address down for a total of 50 rows


    'Replicate the next four lines as necessary
    Set rng = sht.Range("CJ2")
    rng.Formula = "=(IF(INDEX('Data Entry'!$Q:$Q,ROW($Q18))=" & vbNullString & "," & vbNullString & ",IF(INDEX('Data Entry'!$Q:$Q,ROW($Q18))=" & vbNullString & "," & vbNullString & ",INDEX('Data Entry'!$Q:$Q,ROW($Q18)))))"
    rng.Copy
    Range(rng, rng.End(xlDown)).PasteSpecial xlPasteFormulas
    Application.CutCopyMode = False
                                
End Sub
Sub loopAndChangeFormulas()
Dim fPath As String
Dim fName As String, fSaveAsFilePath As String, fOriginalFilePath As String
Dim wBook As Workbook, fFilesToProcess() As String
Dim numconverted As Long, cntToConvert As Long, i As Long
Dim killOnSave As Boolean, xMsg As Long, overWrite As Boolean, pOverWrite As Boolean
Dim silentMode As Boolean
Dim fileType As String
Dim sht As Worksheet
Dim rng As Range


    Application.DisplayAlerts = False 'no user prompting, taking all defaults
    Application.EnableEvents = False
    
    fileType = "*.xls*" 'MAKE CHANGES HERE
        
    fPath = GetFolderName("Select Folder for formula change")
    
    If fPath = "" Then
        MsgBox "You didn't select a folder", vbCritical, "Aborting!"
        Exit Sub
    Else
        fName = Dir(fPath & "\" & fileType)
        If fName = "" Then
            MsgBox "There aren't any " & fileType & " files in the " & fPath & " directory", vbCritical, "Aborting"
            Exit Sub
        Else

            Do
                ReDim Preserve fFilesToProcess(cntToConvert) As String
                fFilesToProcess(cntToConvert) = fName
                cntToConvert = cntToConvert + 1
                
                fName = Dir
                
            Loop Until fName = ""
            
            For i = 0 To cntToConvert - 1
            
                Application.StatusBar = "Processing: " & i + 1 & " of " & cntToConvert & " file: " & fName
                
                fName = fFilesToProcess(i)
                
                'open and convert file
                On Error GoTo errHandler
                fOriginalFilePath = fPath & "\" & fName
                
                Set wBook = Application.Workbooks.Open(fOriginalFilePath)
                
                Call formulaUpdater(wBook, sht) 'update formulas
                
                wBook.Close savechanges:=True
                numconverted = numconverted + 1
                    
            Next i
        End If
    End If
    
processComplete:
    On Error GoTo 0
    MsgBox "Completed formula conversions in " & numconverted & " files", vbOKOnly
    Application.EnableEvents = True 'uncomment if doing other conversions where macros are involved in source workbooks
    Application.StatusBar = False
    Application.DisplayAlerts = True
    Exit Sub
    
errHandler:
    Application.StatusBar = False
    MsgBox "For some reason, could not open/save the file: " & fPath & "\" & fName, vbCritical, "Aborting!"
    Resume processComplete
    
End Sub

Open in new window

See attached workbook

Cheers,

Dave  
loopAndFixFormulas-r2.xlsm
0
 
LVL 80

Assisted Solution

by:byundt
byundt earned 100 total points
ID: 36598510
Dale,
If the data being imported by the formula is always text (and not numbers), then you can simplify your equation to:
=INDEX('Data Entry'!$Q:$Q,ROW($Q18)) & ""

If the cell being referenced is blank, the return value will be an empty string (looks like a blank).
If the cell being referenced is text, its value will be returned unaltered.
If the cell being referenced is a number, however, the value returned will be text that looks like that number. This could be a problem if you are using the returned value in a VLOOKUP or MATCH formula.

If you need to be able to return either text or numbers, then you might use just the last half of the formula from your original question:
=IF(INDEX('Data Entry'!$Q:$Q,ROW($Q18))="","",INDEX('Data Entry'!$Q:$Q,ROW($Q18)))

Brad
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Drop Down List with Unique/Distinct Values (enhancing the Combo-Box with a few steps and a little code) David miller (dlmille) Intro Have you ever created a data validation list from a database field or spreadsheet column (e.g., Zip Codes or Co…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

706 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now