Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Cells(1, "B").Value = "'" & Cells(1, "C").Formula
Sub Addr2Val()
Dim PrecCells As Variant, CellRng As Range, NumP As Long, i As Long, Form As String
Dim CellAddr As String, CellVal As Variant, xCell As Range
Set CellRng = Application.ActiveCell
Form = CellRng.Formula
Form = Replace(Form, "$", "")
Set PrecCells = CellRng.Precedents
For Each xCell In PrecCells
CellAddr = xCell.Address
CellAddr = Replace(CellAddr, "$", "")
CellVal = xCell.Value
Form = Replace(Form, CellAddr, CellVal)
Next
CellRng.Offset(0, 1).Value = " " & Form
Set CellRng = Nothing
Set PrecCells = Nothing
End Sub
Function AddrToVal(CellRng As Range) As String
Dim i As Integer, j As Integer, k As Integer
Dim xChar1 As Integer, Char2 As Integer
Dim Form As String
Dim CellAddr As String
Form = CellRng.Formula
Debug.Print Form
Form = Replace(Form, "$", "")
Form = Replace(Form, "=", "'")
Debug.Print Form
For i = 1 To Len(Form)
xChar1 = Asc(Mid(Form, i, 1))
xChar2 = Asc(Mid(Form, i + 1, 1))
If (xChar1 >= 65) _
And (xChar2 > 47 And xChar2 <= 58) Then
CellAddr = Chr(xChar1) & Chr(xChar2)
Form = Replace(Form, CellAddr, Range(CellAddr).Value)
Debug.Print Form
i = 1
End If
Next i
Debug.Print Form
AddrToVal = Form
End Function
Function AddrToVal(CellRng As Range) As String
Dim i As Integer, j As Integer, k As Integer
Dim xChar1 As Integer, xChar2 As Integer
Dim xChar3 As Integer, xChar4 As Integer, xChar5 As Integer
Dim Form As String
Dim CellAddr As String
Form = CellRng.Formula
Form = Replace(Form, "$", "")
'Form = Replace(Form, "=", "'")
xChar1 = 0: xChar2 = 0: xChar3 = 0: xChar4 = 0: xChar5 = 0
For i = 1 To Len(Form)
If i < Len(Form) Then 'IF01==========
xChar1 = Asc(Mid(Form, i, 1))
xChar2 = Asc(Mid(Form, i + 1, 1)): On Error Resume Next
xChar3 = Asc(Mid(Form, i + 2, 1)): On Error Resume Next
xChar4 = Asc(Mid(Form, i + 3, 1)): On Error Resume Next
xChar5 = Asc(Mid(Form, i + 4, 1)): On Error Resume Next
If xChar1 < 65 Or xChar1 > 90 Then 'IF02==========
GoTo GoToHere01
ElseIf 3 = 3 Then
If xChar2 >= 48 And xChar2 <= 57 _
And xChar3 >= 48 And xChar3 <= 57 _
And xChar4 >= 48 And xChar4 <= 57 Then
CellAddr = Chr(xChar1) & Chr(xChar2) & Chr(xChar3) & Chr(xChar4)
Form = Replace(Form, CellAddr, Range(CellAddr).Value)
i = 1
ElseIf 2 = 2 Then
If xChar2 >= 48 And xChar2 <= 57 _
And xChar3 >= 48 And xChar3 <= 57 Then
CellAddr = Chr(xChar1) & Chr(xChar2) & Chr(xChar3)
Form = Replace(Form, CellAddr, Range(CellAddr).Value)
i = 1
ElseIf xChar2 >= 48 And xChar2 <= 57 Then
CellAddr = Chr(xChar1) & Chr(xChar2)
Form = Replace(Form, CellAddr, Range(CellAddr).Value)
i = 1
End If
End If
End If 'IF02==========
End If 'IF01==========
GoToHere01:
Next i
AddrToVal = Form
End Function
[COLOR=#4E9A06]' xChar1 = 0: xChar2 = 0: xChar3 = 0: xChar4 = 0: xChar5 = 0[/color]
For i = 1 To Len(Form)
xChar1 = 0: xChar2 = 0: xChar3 = 0: xChar4 = 0: xChar5 = 0
Function AddrToVal2(rCell As Range) As String
'SkipVought 2017 AUG 29
Dim i As Integer, p1 As Integer, p2 As Integer
Dim Form As String, eval As String, r As Range
Form = rCell.Formula
Form = Replace(Form, "$", "")
AddrToVal2 = "="
p1 = 2
For i = 2 To Len(Form)
Select Case Mid(Form, i, 1)
Case "(", ")", ",", "+", "-", "*", "/", ":", "&", "^"
p2 = i - 1
eval = Mid(Form, p1, p2 - p1 + 1)
On Error Resume Next
Set r = Range(eval)
If Err.Number = 0 Then
AddrToVal2 = AddrToVal2 & Range(eval).Value & Mid(Form, i, 1)
Else
AddrToVal2 = AddrToVal2 & eval & Mid(Form, i, 1)
Err.Clear
End If
On Error GoTo 0
p1 = i + 1
End Select
Next
End Function
Function AddrToVal2(rCell As Range) As String
'SkipVought 2017 AUG 29
'SkipVought 2017 OCT 31 - Added Evaluate subroutine & 2 GoSub Evaluate
Dim i As Integer, p1 As Integer, p2 As Integer
Dim Form As String, eval As String, r As Range
Form = rCell.Formula
Form = Replace(Form, "$", "")
AddrToVal2 = "="
p1 = 2
For i = 2 To Len(Form)
Select Case Mid(Form, i, 1)
Case "(", ")", ",", "+", "-", "*", "/", ":", "&", "^"
GoSub Evaluate
End Select
Next
GoSub Evaluate
Exit Function
Evaluate:
p2 = i - 1
eval = Mid(Form, p1, p2 - p1 + 1)
On Error Resume Next
Set r = Range(eval)
If Err.Number = 0 Then
AddrToVal2 = AddrToVal2 & Range(eval).Value & Mid(Form, i, 1)
Else
AddrToVal2 = AddrToVal2 & eval & Mid(Form, i, 1)
Err.Clear
End If
On Error GoTo 0
p1 = i + 1
Return
End Function
‘ some code here
GoSub [i]SubroutineName[/i]
‘ more code
GoSub [i]SubroutineName[/i]
‘Even more code
‘...any subroutine may be called 1 or more times and there can be multiple subroutines
‘ Exit [i]ProcedureType[/i]
‘This is where any subroutine(s) go, AFTER the Exit for the procedure.
[i]SubroutineName[/i]
‘Code for this subroutine
Return