Option Explicit
'--  David McRitchie http://www.mvps.org/dmcritchie/excel/formula.htm
'--  http://www.mvps.org/dmcritchie/excel/code/formula.txt

'-- Directions to install VBA code can be found at
' http://www.mvps.org/dmcritchie/excel/getstarted.htm#modulename 
' Install as a new Module  {Insert,  New Module)  (warning not as a class module)
' with name  "McRitchie_Formula"  by changing name of  Module nnn    by selecting
' Module  nnn if not already selected then  get  to View, Properties   using
' F4 {View,  Properties Window} and change the module name.
'
' Also of interest see http://www.mvps.org/dmcritchie/excel/rightclick.htm 
' to add GetFormula_sub to context (right-click) menu.


Function GetFormula(cell As Range) As String
   'Documented in  http://www.mvps.org/dmcritchie/excel/formula.htm
   'Application.Volatile = True
   GetFormula = cell.Formula
End Function

Function GetFormulaD(cell As Range) As String
   'Documented in  http://www.mvps.org/dmcritchie/excel/formula.htm
   'Application.Volatile = True
   GetFormulaD = cell.Address(0, 0) & ":  " & cell.Formula
End Function

Function GetFormat(cell As Range) As String
'Documented in  http://www.mvps.org/dmcritchie/excel/formula.htm
  ' Application.Volatile = True
   On Error Resume Next
   GetFormat = ""
   GetFormat = cell.NumberFormat
End Function

Function GetFormatD(cell As Range) As String
'Documented in  http://www.mvps.org/dmcritchie/excel/formula.htm
  ' Application.Volatile = True
   On Error Resume Next
   GetFormatD = ""
   GetFormatD = cell.Address(0, 0) & ":  " & cell.NumberFormat
End Function


Function GetFormulaI(cell As Range) As String
   'Documented in  http://www.mvps.org/dmcritchie/excel/formula.htm
   'Application.Volatile = True
   If VarType(cell) = 8 And Not cell.HasFormula Then
    GetFormulaI = "'" & cell.Formula
   Else
    GetFormulaI = cell.Formula
   End If
   If cell.HasArray Then _
     GetFormulaI = "{" & cell.Formula & "}"
End Function
Function GetFormulaID(cell As Range) As String
   'Application.Volatile = True
   Dim GetFormulaI As String
   If VarType(cell) = 8 And Not cell.HasFormula Then
    GetFormulaI = "'" & cell.Formula
   Else
    GetFormulaI = cell.Formula
   End If
   If cell.HasArray Then _
     GetFormulaI = "{" & cell.Formula & "}"
   GetFormulaID = cell.Address(0, 0) & ":  " & GetFormulaI
End Function

Function GetFormulaX(cell As Range) As String
   '-- to be used in another formula =indirect(xx) + insdirect(yy)
   'Application.Volatile = True
   If IsEmpty(cell) Then
      GetFormulaX = """"""
   ElseIf VarType(cell) = 8 And Not cell.HasFormula Then
      If Left(cell, 1) = "'" Then
         GetFormulaX = """" & Mid(cell, 2) & """"
      Else
         GetFormulaX = """" & cell & """"
      End If
   ElseIf cell.HasFormula Then
      GetFormulaX = Mid(cell.Formula, 2)
   Else
      GetFormulaX = cell.Formula
   End If
End Function
Function getFontName(cell As Range) As String
   getFontName = cell.Font.Name  'D.McR  formula.htm
End Function


Function GetText(cell As Range) As String
'Documented in  http://www.mvps.org/dmcritchie/excel/formula.htm
  ' Application.Volatile = True
   On Error Resume Next
   GetText = cell.Text
End Function

Function HasFormula(cell)
  'created using a  suggestion by  Nick Manton    nickm@sri.com
  ' http://www.mvps.org/dmcritchie/excel/formula.htm
  HasFormula = cell.HasFormula
End Function


Function ShowFormula(cell As Range) As String
   Application.Volatile
   If cell.HasFormula Then ShowFormula = cell.Formula
End Function

Function FontStyle(cell As Range) As String
    'Won't change value until some value on sheet changes
    Application.Volatile
    FontStyle = cell.Font.FontStyle
End Function

Function CondFormula(myCell As Range, Optional cond As Long = 1) As String
  'Bernie Deitrick programming 2000-02-18, modified D.McR 2001-08-07
  Application.Volatile
  CondFormula = ""
  On Error Resume Next
  CondFormula = myCell.FormatConditions(cond).Formula1
End Function

Sub FormulaBox()
  'David McRitchie  1998-08-12 1999-08-17
  '  http://www.mvps.org/dmcritchie/excel/formula.htm
  'Place material into MsgBox    [ctrl+n]
  'Will process ranges of one or more columns
  'Application.ScreenUpdating = False
  Dim MsgBoxx As String
  Dim ix As Long
  Dim vGetFormulaI As String, xyx As String
  MsgBoxx = "First Character of " _
    & Selection.Item(ix).Address(0, 0) & " is """ _
    & Left(ActiveCell.Value, 1) & """   =CHR(" _
    & Right("0000" & Asc(ActiveCell.Value), 4) & ") or Hex=x'" _
    & Hex(Asc(ActiveCell.Value)) & "'" & Chr(10) _
    & "Last Character is """ & Right(ActiveCell.Value, 1) _
    & """  =CHR(" _
    & Right("0000" & Asc(Right(ActiveCell.Value, 1)), 4) & ") or Hex=x'" _
    & Hex(Asc(Right(ActiveCell.Value, 1))) & "'" & Chr(10) _
    & ActiveCell.Font.Name & " " & ActiveCell.Font.Size _
    & "  " & ActiveCell.Font.FontStyle _
    & ",  color: " & ActiveCell.Font.ColorIndex _
    & "  interior: " & ActiveCell.Interior.ColorIndex _
    & Chr(10) & Chr(10)
    
  For ix = 1 To Selection.Count
      'Selection.Item(ix).NoteText _ ...
      vGetFormulaI = ""
      If VarType(Selection.Item(ix)) = 8 Then
       vGetFormulaI = "'" & Selection.Item(ix).Formula
      Else
       vGetFormulaI = Selection.Item(ix).Formula
      End If
      If Selection.Item(ix).HasArray Then _
        vGetFormulaI = "{" & Selection.Item(ix).Formula & "}"
      
      'include below if VarType wanted -- don't include for distribution
      '   & " " & VarType(Selection.Item(ix)) _ ..
      MsgBoxx = MsgBoxx _
        & Selection.Item(ix).Address(0, 0) _
        & ": " & vGetFormulaI _
        & Chr(10) & "    " & Selection.Item(ix).NumberFormat & Chr(10)

  Next
  MsgBoxx = MsgBoxx & Chr(10) & "***" _
     & Chr(10) & _
     LCase(ActiveWorkbook.FullName) & "  " & ActiveSheet.Name
     'to verify you've  seen everything
  xyx = MsgBox(MsgBoxx, , _
    "FormulaBox: Formula & Format & Text for " _
    & Selection.Count & " selected cells")
  'Application.ScreenUpdating = True
End Sub

Sub FormulaSheet()
    'Print information for each non empty cell DMcRitchie 2001-04-30
    'Documented in  http://www.mvps.org/dmcritchie/excel/formula.htm
    'Also see John Walkenbach  -- Tip 37 which is formulas only

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim irow As Long, cell As Range
    Dim oSheet As Worksheet, nSheet As Worksheet
    Dim oCells As Range
    irow = 1
    Set oSheet = ActiveSheet
    Set nSheet = ActiveWorkbook.Worksheets.Add
    nSheet.Name = oSheet.Name & " content at " _
         & Format(Now(), "hhmss")
    nSheet.Cells(1, 1) = "Cell"
    nSheet.Cells(1, 2) = "Text"
    nSheet.Cells(1, 3) = "Value"
    nSheet.Cells(1, 4) = "Formula"
    nSheet.Cells(1, 5) = "NumberFormat"

    For Each cell In oSheet.UsedRange
      If Not IsEmpty(cell) Then
        irow = irow + 1
        Cells(irow, 1).Value = cell.Address(0, 0)
        Cells(irow, 2).Value = "'" & cell.Text
        Cells(irow, 3).Value = cell.Value
        Cells(irow, 4).Value = "'" & cell.Formula
        Cells(irow, 5).Value = "'" & cell.NumberFormat
      End If
    Next cell
    Columns("A:F").EntireColumn.AutoFit
    Rows("1:1").Font.Bold = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 
Function UseFormula(cell)
'David McRitchie  Jul 20, 1998  if this is valid will be
'Documented in  http://www.mvps.org/dmcritchie/excel/formula.htm
    UseFormula = Application.Evaluate(cell.Formula)
    'If "'" <> Left(cell.formula, 1) Then UseFormula = "'" & cell.formula
End Function

Function UseFormula2(cell As Range) As String
   'Documented in  http://www.mvps.org/dmcritchie/excel/formula.htm
   'UseFormula Jul 20, 1998,  UseFormula2 Jun 13, 2000
   'Application.Volatile = True  -- DO NOT DO THIS
   'GetFormula = cell.Formula
    If Trim(cell.Value) = "" Then
       UseFormula2 = ""
       Exit Function
    ElseIf Left(cell.Value, 1) = "=" Then
       UseFormula2 = Application.Evaluate(cell.Formula)
       Exit Function
    Else
       UseFormula2 = "'#bad formula"
    End If
End Function

Function UseSameAs(cell As Range)
   '-- Use the same Formula as used in the referenced cell
   '-- http://mvps.org/dmcritchie/excel/formula.htm#usesameas  2005-09-03 .excel
      Application.Volatile
      If cell.HasFormula Then
        UseSameAs = Application.Caller.Parent.Evaluate(cell.Formula)
      Else   '-- needed if constant looks like a cell address
        UseSameAs = cell.Value
      End If
End Function

Function ISBOLD(cell As Range) As Boolean
   If cell.Font.Bold Then ISBOLD = True
End Function

'-- The following macros have been moved to McRitchie_insrtrow  (insrtrow.txt)
'-- InsertRowsAndFillFormulas(Optional vRows As Long = 0)
'-- InsertBlankRows()
'-- InsertBlankRowBeforeLast()
'-- Guarantee2RowsAfterA_values()

Sub WhereAmI()
    'D.McRitchie,  pathname.htm, excel.misc 1999-07-30
    MsgBox ActiveWorkbook.FullName & Chr(10) & _
      "Microsoft Excel is using " & Application.OperatingSystem
End Sub
Sub Euro_Format()
    Selection.NumberFormat = _
        "_(€* #,##0.00_);_(€* (#,##0.00);_(€* "" - ""???_);_(@_)"
End Sub
Function showAlign(cell As Range) As String
   'David McRitchie,       2004-09-15
   '   based on http://www.mvps.com/dmcritchie/excel/code/xl2htmlx.txt
   Dim ca As String
   If Trim(Replace(cell.Text, Chr(160), "")) = "" Then
        ca = "N/A"
    ElseIf cell.HorizontalAlignment = -4138 Then
           ca = "Left"
    ElseIf cell.HorizontalAlignment = -4108 Then
       ca = "Center"
    ElseIf cell.HorizontalAlignment = -4131 Then
       ca = "Left"
    ElseIf cell.HorizontalAlignment = -4152 Then
       ca = "Right"
    ElseIf IsNumeric(cell) Then
       ca = "Right"
    Else
       ca = "Left"
    End If  '-4138 left, -4108 center, -4152 right, HTML default left
    showAlign = ca
End Function