Sub test()
For Each c In Selection
If c.HasFormula Then
cellform = c.Formula
For i = 1 To Len(cellform)
If Mid(cellform, i, 1) = "=" Or Mid(cellform, i, 1) = "+" Or Mid(cellform, i, 1) = "*" _
Or Mid(cellform, i, 1) = ")" Or Mid(cellform, i, 1) = "(" Then
NewForm = NewForm & Mid(cellform, i, 1)
ElseIf Mid(cellform, i, 1) = "$" Then
If Mid(cellform, i + 2, 1) = "$" Then
For LetPos = 65 To 90
If Mid(cellform, i + 1, 1) = Chr(LetPos) Then
AlphabetLetter = Chr(LetPos)
OffSetNumber = 65 - LetPos
cell_Ref = Mid(cellform, i, 4)
cell_Val = Range(cell_Ref).Offset(0, OffSetNumber).Value
NewForm = NewForm & cell_Val
End If
Next LetPos
i = i + 3
Else
For LetPos = 65 To 90
If Mid(cellform, i + 1, 1) = Chr(LetPos) Then
AlphabetLetter = Chr(LetPos)
OffSetNumber = 65 - LetPos
cell_Ref = Mid(cellform, i, 3)
cell_Val = Range(cell_Ref).Offset(0, OffSetNumber).Value
NewForm = NewForm & cell_Val
End If
Next LetPos
i = i + 2
End If
ElseIf Application.IsText(Mid(cellform, i, 1)) = True Then
If Mid(cellform, i + 1, 1) = "$" Then
For LetPos = 65 To 90
If Mid(cellform, i, 1) = Chr(LetPos) Then
AlphabetLetter = Chr(LetPos)
OffSetNumber = 65 - LetPos
cell_Ref = Mid(cellform, i, 3)
cell_Val = Range(cell_Ref).Offset(0, OffSetNumber).Value
NewForm = NewForm & cell_Val
End If
Next LetPos
i = i + 1
Else
For LetPos = 65 To 90
If Mid(cellform, i, 1) = Chr(LetPos) Then
AlphabetLetter = Chr(LetPos)
OffSetNumber = 65 - LetPos
cell_Ref = Mid(cellform, i, 2)
cell_Val = Range(cell_Ref).Offset(0, OffSetNumber).Value
NewForm = NewForm & cell_Val
End If
Next LetPos
End If
End If
Next i
'Call Word and use put there instead but for testing purposes use debug.print
Cells(6, 3).Value = "Cell " & c.Address & ":" & c.Offset(0, -1).Value & NewForm
End If
Next
End Sub