Question

I'm able to grab values from a closed workbook with the widely found GetValues function; it works great.

But sometimes I need to grab the formula of a cell from the closed workbook. I tried modifying GetValues to grab the cells formula but I'm getting errors.

How to get a formula (not simple value) of cells from a closed excel file?

With Sheets
  For r = 2 To NewRowQty ' from second row to last row
    For c = 1 To ThisColumnEnd ' out to EndColumn (from import dialogue box)
      ThisCell = Cells(r, c).Address
      ThisValue = GetValue(ThisPath, ThisFile, ThisSheet, ThisCell)
      If ThisValue <> "0" Then
        If c = 3 And r > 2 Then
          Cells(r, c).Formula = GetFormula(ThisPath, ThisFile, ThisSheet, ThisCell)
        Else
          Cells(r, c) = ThisValue
        End If
      End If
    Next c
  Next r
End With

Calls these two functions, GetValue works fine, GetFormula won't grab the formula.

Private Function GetValue(p, f, s, c)
  'p: path: The drive and path to the closed file (e.g., "d:\files")
  'f: file: The workbook name (e.g., "budget.xls")
  's: sheet: The worksheet name (e.g., "Sheet1")
  'c: cell: The cell reference (e.g., "C4")

  'Retrieves a value from a closed workbook
  Dim arg As String
  'Make sure the file exists
  If Right(p, 1) <> "\" Then p = p & "\"
  If Dir(p & f) = "" Then
    GetValue = "File Not Found"
    Exit Function
  End If
  'Create the argument
  arg = "'" & p & "[" & f & "]" & s & "'!" & _
  Range(c).Range("A1").Address(, , xlR1C1)
  'Execute an XLM macro
  GetValue = ExecuteExcel4Macro(arg)
End Function

Private Function GetFormula(p, f, s, c)
  'p: path: The drive and path to the closed file (e.g., "d:\files")
  'f: file: The workbook name (e.g., "budget.xls")
  's: sheet: The worksheet name (e.g., "Sheet1")
  'c: cell: The cell reference (e.g., "C4")

  'Retrieves a value from a closed workbook
  Dim arg As String
  'Make sure the file exists
  If Right(p, 1) <> "\" Then p = p & "\"
  If Dir(p & f) = "" Then
    GetFormula = "File Not Found"
    Exit Function
  End If
  'Create the argument
  arg = "'" & p & "[" & f & "]" & s & "'!" & _
  Range(c).Range("A1").Address(, , xlR1C1).Formula
  'Execute an XLM macro
  GetFormula = ExecuteExcel4Macro(arg)
End Function

Update: Joel's first code post was the basis of what I ended up using so I marked that correct. Here's my actual implementation using a copy paste of entire row formulas. This is best because I don't know how many columns out may contains values or formulas, could be C or ZZ.

' silent opening of old file:
Application.EnableEvents = False
Set o = GetObject(FileTextBox.Text)
With Sheets
    For r = 2 To NewRowQty ' from second row to last row
        ThisCell = "A" & r
        o.Worksheets(ThisRate).Range(ThisCell).EntireRow.Copy
        Sheets(ThisRate).Range(ThisCell).PasteSpecial xlFormulas
    Next r
End With
' Close external workbook, don't leave open for extended periods
Set o = Nothing
Application.EnableEvents = True
Was it helpful?

Solution

Why such convoluted code? The code you are using, for some reason, is invoking the Excel 4.0 backwards compatibility mode macro processor. I can't imagine why you would do that.

Here's a simple way to get the formula from cell Sheet1!A1 of c:\tmp\book.xlsx:

Dim o As Excel.Workbook
Set o = GetObject("c:\tmp\Book.xlsx")
MsgBox o.Worksheets("Sheet1").Cells(1, 1).Formula
Set o = Nothing ' this ensures that the workbook is closed immediately

OTHER TIPS

If you insist on running Excel 4 - style macros (obsolete in 1994!) you need to use the XLM function GET.FORMULA to retrieve the formula instead of the value as follows:

arg = "GET.FORMULA('" & p & "[" & f & "]" & s & "'!" & _
      Range(c).Range("A1").Address(, , xlR1C1) & ")"

Note that the result will have formulas using R1C1 notation instead of A1 notation.

Converting back to A1 notation (if you really want to do that) is left as an exercise to the reader.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top