VBA Snippets
Cell_FormulaExtract
Public Function Cell_FormulaExtract(ByVal sformulas As String, _
ByVal lResultsFirstRow As Long, _
ByVal lrowno As Long) As String
Dim iopenbracket As Integer
Dim iopenbracketcurly As Integer
Dim iclosebracket As Integer
Dim sfunction As String
Dim sinsidefunction As String
Dim ifindspeechmark As Integer
Dim sfoundrange As String
Dim sopenbracket As String
Dim sclosebracket As String
Dim smodified As String
Dim ifindseperator As Integer
Dim ifindampersand As Integer
Dim ifindcomma As Integer
Dim ifindclosingspeech As Integer
'check for string concatenations
If (g_bInsideFunction = True) Then
If Left(sformulas, 1) = """" Then
ifindclosingspeech = InStr(Right(sformulas, Len(sformulas) - 1), """")
If (ifindclosingspeech > -1) Then
ifindampersand = InStr(Right(sformulas, Len(sformulas) - 1), "&")
If (ifindampersand = 0) Then
If (Factset_StringArgument(sformulas) = False) Then
'then its a string
' Cells(g_lRowNo, g_lColNo).Value = UCase(sformulas)
g_vExtractFunctions(g_lArrayRowNo, enCOLUMNS_TABLE2.e3FactSetArg1 + g_lColNo) = UCase(sformulas)
g_lColNo = g_lColNo + 1
Else
'split the argument into different columns
ifindcomma = InStr(sformulas, ",") - 1
g_vExtractFunctions(g_lArrayRowNo, enCOLUMNS_TABLE2.e3FactSetArg1 + g_lColNo) = UCase(Left(sformulas, ifindcomma))
g_lColNo = g_lColNo + 1
End If
End If
If (ifindampersand > -1) Then
If (ifindclosingspeech + 1 = ifindampersand) Then
' Cells(g_lRowNo, g_lColNo).Value = UCase(Left(sformulas, ifindampersand))
g_vExtractFunctions(g_lArrayRowNo, enCOLUMNS_TABLE2.e3FactSetArg1 + g_lColNo) = UCase(Left(sformulas, ifindampersand))
g_lColNo = g_lColNo + 1
End If
End If
End If
End If
End If
If IsNumeric(sformulas) = True Or _
UCase(sformulas) = "TRUE" Or UCase(sformulas) = "FALSE" Then
sformulas = Replace(sformulas, ", ", ",")
sformulas = Replace(sformulas, ",", ", ")
Cell_FormulaExtract = sformulas 'just return the value
Else
ifindseperator = Str_CharsFindPositionofNext(sformulas, _
"""", ";", "(", "&", "{", ",", "+", "^", "-", "*", "/", "=", "<", ">")
iopenbracket = InStr(1, sformulas, "(")
'stupid function returns 0 when no match
If iopenbracket = 0 Then iopenbracket = -1
iopenbracketcurly = InStr(1, sformulas, "{")
'stupid function returns 0 when no match
If iopenbracketcurly = 0 Then iopenbracketcurly = -1
If (iopenbracket >= 1) And (iopenbracketcurly >= 1) Then
If (iopenbracket < iopenbracketcurly) Then
iopenbracketcurly = -1
Else
iopenbracket = -1
End If
End If
If (ifindseperator < iopenbracket) And (ifindseperator < iopenbracketcurly) Then
iopenbracket = -1
iopenbracketcurly = -1
End If
If ((iopenbracket >= 1) And (iopenbracket <= ifindseperator)) Or _
((iopenbracketcurly >= 1) And (iopenbracketcurly <= ifindseperator)) Then
If (iopenbracket >= 1) Then
sopenbracket = "("
sclosebracket = ")"
End If
If (iopenbracketcurly >= 1) Then
sopenbracket = "{"
sclosebracket = "}"
iopenbracket = iopenbracketcurly
End If
iclosebracket = Cell_FormulaCloseBracketPos(sformulas, sopenbracket, sclosebracket)
sfunction = Mid(sformulas, 1, iopenbracket - 1)
' Debug.Print "Function-" & sfunction
If (Trim(sfunction) = "FDS") Or _
(Trim(sfunction) = "FDSB") Or _
(Trim(sfunction) = "FDSC") Or _
(Trim(sfunction) = "FDSZ") Then
g_lArrayRowNo = g_lArrayRowNo + 1
g_lColNo = 0
'Cells(g_lRowNo, g_lColNo).Value = lrowno + lResultsFirstRow
g_vExtractFunctions(g_lArrayRowNo, enCOLUMNS_TABLE2.e1Table1RowNo) = lrowno
'Cells(g_lRowNo, g_lColNo + 1).Value = Trim(sfunction)
g_vExtractFunctions(g_lArrayRowNo, enCOLUMNS_TABLE2.e2FactSetFunction) = Trim(sfunction)
' Cells(g_lRowNo, g_lColNo + 3).Value = ""
' Cells(g_lRowNo, g_lColNo).Interior.Color = g_lSHADING_ExtractFunctions
g_bInsideFunction = True
End If
sinsidefunction = Mid(sformulas, iopenbracket + 1, iclosebracket - iopenbracket - 1)
If Len(sinsidefunction) > 0 Then
smodified = Cell_FormulaExtract(sinsidefunction, lResultsFirstRow, lrowno)
End If
If iclosebracket < Len(sformulas) Then
g_bInsideFunction = False
smodified = Cell_FormulaExtract(Right(sformulas, Len(sformulas) - iclosebracket), lResultsFirstRow, lrowno)
End If
Else
smodified = ""
ifindspeechmark = Str_CharsFindPositionofNext(sformulas, """")
ifindseperator = Str_CharsFindPositionofNext(sformulas, _
";", "&", ",", "+", "-", "^", "*", "/", "=", "<", ">", " ") 'added a space
If ifindspeechmark > -1 And ifindspeechmark < ifindseperator Then
ifindseperator = Str_FindSingleSpeechmark(sformulas) + 1
End If
If ifindseperator = 1 Then
Select Case Left(sformulas, 1)
'check there are spaces after every comma
Case ",":
If (Left(sformulas, 2) <> ", ") Then
smodified = smodified & ", "
Else
smodified = smodified & ","
End If
Case "<":
smodified = smodified & "<"
Case ">":
smodified = smodified & ">"
Case Else:
smodified = smodified & Left(sformulas, 1)
End Select
smodified = smodified & Cell_FormulaExtract(Right(sformulas, Len(sformulas) - 1), lResultsFirstRow, lrowno)
ElseIf ifindseperator > 1 Then
sfoundrange = Left(sformulas, ifindseperator - 1)
If Cell_RangeIsIt(sfoundrange) = True Then
If (g_bInsideFunction = True) Then
'Cells(g_lRowNo, g_lColNo).Value = Replace(sfoundrange, "$", "")
g_vExtractFunctions(g_lArrayRowNo, enCOLUMNS_TABLE2.e3FactSetArg1 + g_lColNo) = Replace(sfoundrange, "$", "")
g_lColNo = g_lColNo + 1
End If
smodified = sfoundrange
smodified = smodified & Cell_FormulaExtract(Right(sformulas, Len(sformulas) - ifindseperator + 1), lResultsFirstRow, lrowno)
Else
smodified = smodified & Left(sformulas, ifindseperator - 1)
smodified = smodified & Cell_FormulaExtract(Right(sformulas, Len(sformulas) - ifindseperator + 1), lResultsFirstRow, lrowno)
End If
End If
End If
Cell_FormulaExtract = smodified
End If
Exit Function
ErrorHandler:
Call MsgBox(Err.Number + " " & Err.Description)
End Function
Formulas_ExtractFunctions
Public Sub Formulas_ExtractFunctions()
Dim oProgressBar As frmProgressBar
Dim wbk_active As Excel.Workbook
Dim wsh_active As Excel.Worksheet
Dim lStartRow As Long
Dim llastrow As Long
Dim sFormula As String
Dim lColNo As Long
Dim lrowno As Long
Dim lResultsFirstRow As Long
Dim oColumnRange As Range
Dim llastrow_array As Long
On Error GoTo ErrorHandler
Application.Calculation = xlCalculationManual
Set wbk_active = ActiveWorkbook
Set wsh_active = wbk_active.ActiveSheet
Set oProgressBar = frmProgressBar
Load oProgressBar
oProgressBar.Show (VBA.FormShowConstants.vbModeless)
Call UpdateProgress(oProgressBar, 0.4, "Data")
llastrow = Range(Range("A" & g_lEXTRACT_FUNCTIONS_STARTROW).End(XlDirection.xlDown).Address).Row
' llastrow = wsh_active.Range("A" & modConstants.g_lEXTRACT_FUNCTIONS_STARTROW).SpecialCells(XlCellType.xlCellTypeLastCell).Row
lResultsFirstRow = modConstants.g_lEXTRACT_FUNCTIONS_STARTROW
Dim scolfirst As String
Dim scollast As String
scolfirst = Col_Letter(enCOLUMNS_TABLE1.e8Blank + 1)
scollast = Col_Letter(enCOLUMNS_TABLE1.e8Blank + 1 + enCOLUMNS_TABLE2.e30Description)
Range(scolfirst & modConstants.g_lEXTRACT_FUNCTIONS_STARTROW & ":" & scollast & "20000").ClearContents
ReDim g_vExtractFunctions(1 To llastrow * 3, 1 To (enCOLUMNS_TABLE2.e30Description))
g_lArrayRowNo = 0
For lrowno = lResultsFirstRow To llastrow
sFormula = Range("A" & lrowno).Value
g_lColNo = 0
g_bInsideFunction = False
If (Len(sFormula) > 0) Then
Call Cell_FormulaExtract(sFormula, modConstants.g_lEXTRACT_FUNCTIONS_STARTROW, lrowno)
End If
Call UpdateProgress(oProgressBar, lrowno / llastrow, "Formulas")
Next lrowno
Unload oProgressBar
scolfirst = Col_Letter(enCOLUMNS_TABLE1.e8Blank + 1)
scollast = Col_Letter(enCOLUMNS_TABLE1.e8Blank + 1 + enCOLUMNS_TABLE2.e11FactSetArg9)
If (UBound(g_vExtractFunctions, 1) < wsh_active.Cells.Rows.Count) Then
llastrow_array = UBound(g_vExtractFunctions, 1)
Else
llastrow_array = wsh_active.Cells.Rows.Count
End If
Range(scolfirst & modConstants.g_lEXTRACT_FUNCTIONS_STARTROW & ":" & scollast & llastrow_array).Value = g_vExtractFunctions
With wsh_active.Range("D" & modConstants.g_lEXTRACT_FUNCTIONS_STARTROW - 1 & ":" & _
"G" & modConstants.g_lEXTRACT_FUNCTIONS_STARTROW - 1)
.Value = Array("FactSet", "LSEG", "Factset Sample", "LSEG Sample")
.Font.Bold = True
End With
' wsh_active.Columns("C:D").ColumnWidth = 4
Set oColumnRange = wsh_active.Columns(Col_Letter(enCOLUMNS_TABLE1.e8Blank + enCOLUMNS_TABLE2.e1Table1RowNo) & ":" & _
Col_Letter(enCOLUMNS_TABLE1.e8Blank + enCOLUMNS_TABLE2.e11FactSetArg9))
oColumnRange.HorizontalAlignment = XlHAlign.xlHAlignLeft
Set oColumnRange = wsh_active.Columns("H:H")
oColumnRange.EntireColumn.AutoFit
'Call modMessages.Message_Cells_FunctionsExtracted
Exit Sub
ErrorHandler:
MsgBox (Err.Number & " - " & Err.Description)
End Sub
© 2025 Better Solutions Limited. All Rights Reserved. © 2025 Better Solutions Limited Top