When attempting to open one of my MS-Excel Workbooks that includes a set of Macros (in VBA), I get an unending series of error-messages. I have to kill the LibreOffice program to get out of the endless loop. The Workbook opens just fine if I don’t enable Macros - but is then unusable.
The error-message is:
BASIC syntax error.
Symbol expected.
with the following code-line indicated:
Private Function TLR_Root(Row As Integer, Base As Double)
highlighting the comma after “Integer”
This code both loads and runs in Excel 2003.
This looks to be a mysterious syntax-parsing error in Calc.
My full code is listed below; the error shows in the last function:
'+--------------------------------+----------+--------------------------------+
'|================================| RCC_Code |================================|
'+--------------------------------+----------+--------------------------------+
'| This code supports accessing elements of the data in the RCC Worksheet for |
'| use in cells and formulae in other Worksheets. © 2000-2025 Terry Roddy |
'+----------------------------------------------------------------------------+
'| Permission given for non-commercial use, in whole or in part, if the above |
'| copyright notice is included, and the resulting code is also open-sourced. |
'+----------------------------------------------------------------------------+
'| Date Author History |
'| ========== =========== =================================================== |
'| 02/17/1998 Terry Roddy Inception |
'| 04/29/2000 Terry Roddy Updated CalcRow() for parametric-processing. |
'+----------------------------------------------------------------------------+
Option Explicit ' Require Variable-Delcarations
Option Compare Text ' Case-Insensitive String-Comparisons
' +------------------+
' | GLOBAL VARIALBES |
' +------------------+
Private NumRaces As Integer ' Number of Races listed in RCC Table
Private Races() As String ' List of Races in RCC Table
Private AttribCol As Integer ' Start-Column for Attributes
Private BonusCol As Integer ' Start-Column for Bonuses
Private RulesCol As Integer ' Start-Column of Reference
Private ParamCol As Integer ' Start-Column for Parameters
Private NumStats As Integer ' Number of Racial-Statistics in RCC Table
Private Stats() As String ' List of Statistics in RCC Table
Private StatCol() As Integer ' Leftmost-Column of Stat-specification data
Private StatSize() As Integer ' Number of Columns for a Stat-Specification
Private AttIndex As Integer ' Index of first Attribute in Stats()
Private BonIndex As Integer ' Index of first Bonus in Stats()
Private RulIndex As Integer ' Index of Reference Section
Private ParIndex As Integer ' Index of first Parameter in Stats()
Private Human() ' Averaged evaluation of Human statistics
Private Delta() ' Averaged differences from Human statistics
' +==========================================================+
' | Initialize the global information, in the correct order. |
' +----------------------------------------------------------+
Public Function Initialize() As Boolean
AttribCol = Worksheets("RCC").Range("Stats").Column
BonusCol = Worksheets("RCC").Range("Bonuses").Column
RulesCol = Worksheets("RCC").Range("RulesPage").Column
ParamCol = Worksheets("RCC").Range("Parameters").Column
Initialize = LoadHuman(LoadRaces(LoadStats(True)))
End Function ' Public Function Initialize()
' +=====================================================================+
' | Load the 'Stats()' Array with the names of the various Stat fields. |
' +---------------------------------------------------------------------+
Private Function LoadStats(Flag As Boolean) As Boolean
Dim RetVal As Boolean
Dim Index As Integer
Dim R As Range
RetVal = Flag
If (RetVal) Then ' If we started False, automatically FAIL
On Error GoTo FAIL
' +-------------------------------------------------+
' | Count the number of Racial Statistics supported |
' +-------------------------------------------------+
NumStats = 0
For Each R In Worksheets("RCC").Range("1:1")
If (R.Column < AttribCol) Then ' Skip to first statistic-set
' Do Nothing
ElseIf (Not (IsEmpty(R.Cells(1, 1)))) Then ' Parameter Named
NumStats = NumStats + 1
Select Case (R.Column)
Case AttribCol
AttIndex = NumStats
Case BonusCol
BonIndex = NumStats
Case RulesCol
RulIndex = NumStats
Case ParamCol
ParIndex = NumStats
End Select ' Select Case (R.Column)
ElseIf (R.Column >= ParamCol) Then
If (ParIndex = 0) Then ParIndex = NumStats + 1
Exit For
End If ' If (R.Cells(1, 1).Value = "")...ElseIf...ElseIf
Next ' For Each R In Worksheets("RCC").Range("1:1")
' +---------------------------------------------------+
' | Set the lengths of the Stat-related global arrays |
' +---------------------------------------------------+
ReDim Stats(NumStats)
ReDim StatCol(NumStats)
ReDim StatSize(NumStats)
ReDim Human(NumStats)
ReDim Delta(NumStats)
' +-----------------------------------------------------+
' | Now, fill in the Stat-Names for each supported Stat |
' +-----------------------------------------------------+
Index = 0
For Each R In Worksheets("RCC").Range("1:1")
If (R.Column < AttribCol) Then ' Skip to first statistic-set
' Do Nothing
ElseIf (Not (IsEmpty(R.Cells(1, 1)))) Then ' Statistic Named
Index = Index + 1 ' 1-based lookups, so pre-increment
Stats(Index) = R.Cells(1, 1).Value ' Extract stat-name
StatCol(Index) = R.Column
StatSize(Index) = 1 ' We have at least one spec-column
ElseIf (R.Column >= ParamCol) Then
Exit For
Else
StatSize(Index) = StatSize(Index) + 1 ' Another spec-column
End If 'If (R.Cells(1, 1).Value = "")...ElseIf...ElseIf...Else
Next ' For Each R In Worksheets("RCC").Range("1:1")
Else
FAIL: RetVal = False
End If ' If (RetVal)...Else
LoadStats = RetVal
End Function ' Private Function LoadStats(Flag As Boolean)
' +=====================================================================+
' | Load the 'Races()' Array with the names of the various Race fields. |
' +---------------------------------------------------------------------+
Private Function LoadRaces(Flag As Boolean) As Boolean
Dim RetVal As Boolean
Dim Index As Integer
Dim R As Range
RetVal = Flag
If (RetVal) Then ' If we started False, automatically FAIL
On Error GoTo FAIL
' +----------------------------------------------------------+
' | Count the number of Races supported in the RCC Worksheet |
' +----------------------------------------------------------+
NumRaces = 0
For Each R In Worksheets("RCC").Range("A:A")
If (IsEmpty(R.Cells(1, 1))) Then ' Stop at end-of-list
Exit For
Else
NumRaces = NumRaces + 1
End If
Next
ReDim Races(NumRaces)
' +-----------------------------------------------------------+
' | Extract the Race-Names for each Race in the RCC Worksheet |
' +-----------------------------------------------------------+
Index = 0
For Each R In Worksheets("RCC").Range("A:A")
If (IsEmpty(R.Cells(1, 1))) Then ' Stop at end-of-list
Exit For
Else
Index = Index + 1 ' Pre-Increment for 1-based lookups
Races(Index) = R.Cells(1, 1).Value
End If ' If (R.Cells(1, 1).Value = "")...Else
Next ' For Each R In Worksheets("RCC").Range("Races")
Else
FAIL: RetVal = False
End If ' If (RetVal)...Else
LoadRaces = RetVal
End Function ' Private Function LoadRaces(Flag As Boolean)
' +=================================================+
' | Returns the specified Attribute Statistic-Block |
' +-------------------------------------------------+
Private Function GetAttr(Stat As Variant, Race As Variant) As Range
Dim R As Range
Set R = Worksheets("RCC").Cells(Race, StatCol(Stat))
Set R = R.Resize(1, StatSize(Stat))
Set GetAttr = R
End Function ' Private Function GetAttr(Stat As String, Race)
' +==================================================================+
' | Load the 'Human()' Array with the averages from the Stat fields. |
' +------------------------------------------------------------------+
Private Function LoadHuman(Flag As Boolean) As Boolean
Dim RetVal As Boolean
Dim Index As Integer
Dim Stat As Variant
Dim Race As Variant
Dim HumRow As Integer
RetVal = Flag
If (RetVal) Then ' If we started False, automatically FAIL
On Error GoTo FAIL
' +----------------------------------+
' | Clear the entries from 'Human()' |
' +----------------------------------+
For Index = 1 To NumStats
Human(Index) = 0
Next
' +----------------------------------------------+
' | Determine the Row-Index for the "Human" Race |
' +----------------------------------------------+
For HumRow = 1 To NumRaces
If (Races(HumRow) Like "Human") Then Exit For
Next ' For HumRow = 0 To NumRaces
If (HumRow > NumRaces) Then GoTo FAIL ' "Human" not found in Races
' +------------------------------------------------+
' | Calculate the base values for the "Human" Race |
' +------------------------------------------------+
If (Not (LoadDelta(HumRow))) Then
GoTo FAIL
Else
For Index = 1 To ParIndex - 1
Human(Index) = Delta(Index)
Next
End If ' If (Not (LoadDelta(HumRow)))...Else
Else
FAIL: RetVal = False
End If ' If (RetVal)...Else
LoadHuman = RetVal
End Function ' Private Function LoadHuman(Flag As Boolean)
' +=========================================================================+
' | Load the 'Delta()' Array with the average Stat-differences -vs- Humans. |
' +-------------------------------------------------------------------------+
Private Function LoadDelta(Row) As Boolean
Dim RetVal As Boolean
Dim R As Range
Dim Stat As Integer
Dim Dice As Variant
Dim Sides As Variant
Dim Mul As Variantt
Dim Adds As Variant
RetVal = True ' Assume SUCCESS
If (Worksheets("RCC").Cells(Row, 1) <> "") Then ' Only if Race is defined
On Error GoTo FAIL
' +----------------------------------------------+
' | Cycle through the Stats for the indexed Race |
' +----------------------------------------------+
For Stat = 1 To ParIndex - 1
Set R = GetAttr(Stat, Row)
If (Stat = RulIndex) Then ' Skip the Reference Section
Delta(Stat) = ""
ElseIf (StatSize(Stat) >= 4) Then ' Process Standard Parameters
Dice = R.Cells(1, 1).Value
Sides = R.Cells(1, 2).Value
Mult = R.Cells(1, 3).Value
Adds = R.Cells(1, 4).Value
If (Not (IsNumeric(Dice))) Then Dice = 0
If (Not (IsNumeric(Sides))) Then Sides = 0
If (Not (IsNumeric(Mult))) Then Mult = 0
If (Not (IsNumeric(Adds))) Then Adds = 0
Delta(Stat) = Adds + Mult * (Dice * (Sides + 1) / 2) ' Average
' +---------------------------------------------+
' | Perform the Stat-specific value-adjustments |
' +---------------------------------------------+
Select Case (Stats(Stat)) ' Case-Insensitive match
Case "Regneration" ' Non-Standard Format
Select Case (R.Cells(1, 5)) ' Regeneration Rate
Case "act"
Delta(Stat) = Delta(Stat) * 25
Case "turn"
Delta(Stat) = Delta(Stat) * 10
Case "min"
Delta(Stat) = Delta(Stat) * 5
Case "5m"
Delta(Stat) = Delta(Stat) * 2
Case "hour"
Delta(Stat) = Delta(Stat) * 1
Case "day" ' Recovers once per day - the 'standard' rate
Delta(Stat) = Delta(Stat) * 0
Case "0" ' No innate recovery (non-living)
Delta(Stat) = Delta(Stat) * -1
Case "-1" ' Rapid (daily or faster) decay; no recovery
Delta(Stat) = Delta(Stat) * -10
Case Else ' Unrecognized time-period - treat as "day"
Delta(Stat) = Delta(Stat) * 0
End Select ' Select Case (R.Cells(1, 5))
Case "MDC", "MDC/Level" ' Mega-Damage Capacity
Delta(Stat) = Delta(Stat) * 100 ' MDC:1 = SDC:100
Case Else ' Standard Format: Dice Sides Mult Adds
' +--------------------------------------------------+
' | No adjustments for standard Attributes and Stats |
' +--------------------------------------------------+
End Select ' Select Case (Stat)
Delta(Stat) = Delta(Stat) - Human(Stat) ' Calculate difference
ElseIf (StatSize(Stat) = 1) Then ' Extract Bonuses, Etc.
Delta(Stat) = R.Cells(1, 1).Value
End If
Next ' For Stat = 0 To NumStats
RetVal = True
Else
FAIL: RetVal = False
End If ' If (Worksheets("RCC").Cells(Race, 1) <> "")...Else
LoadDelta = RetVal
End Function ' Private Function LoadDelta(Race As Integer)
' +========================================================================+
' | This function returns a string of the form "NdS" for a specified Stat. |
' +------------------------------------------------------------------------+
Public Function GetDice(Race As String, Stat As String) As String
Dim RetVal
Dim R As Range
Dim Row As Integer
Dim Col As Integer
On Error GoTo FAIL
Row = NameRow(Race)
Col = NameCol(Stat)
If ((Row > 0) And (Col > 0)) Then
Set R = Worksheets("RCC").Cells(Row, Col).Resize(1, 4)
RetVal = CStr(R.Cells(1, 1).Value)
If (RetVal <> "") Then
RetVal = RetVal + "d" + CStr(R.Cells(1, 2).Value)
End If
Else
FAIL: RetVal = ""
End If
GetDice = RetVal
End Function ' Public Function GetDice(Race As String, Stat As String)
' +==================================================+
' | Return the Multiplier for a specified Statistic. |
' +--------------------------------------------------+
Public Function GetMult(Race As String, Stat As String)
Dim RetVal
Dim R As Range
Dim Row As Integer
Dim Col As Integer
On Error GoTo FAIL
Row = NameRow(Race)
Col = NameCol(Stat)
If ((Row > 0) And (Col > 0)) Then
Set R = Worksheets("RCC").Cells(Row, Col).Resize(1, 4)
RetVal = CStr(R.Cells(1, 3).Value)
Else
FAIL: RetVal = ""
End If
GetMult = RetVal
End Function ' Public Function GetMult(Race As String, Stat As String)
' +=================================================+
' | Return the Additives for a specified Statistic. |
' +-------------------------------------------------+
Public Function GetAdds(Race As String, Stat As String)
Dim RetVal
Dim R As Range
Dim Row As Integer
Dim Col As Integer
On Error GoTo FAIL
Row = NameRow(Race)
Col = NameCol(Stat)
If ((Row > 0) And (Col > 0)) Then
Set R = Worksheets("RCC").Cells(Row, Col).Resize(1, 4)
RetVal = CStr(R.Cells(1, 4).Value)
Else
FAIL: RetVal = ""
End If
GetAdds = RetVal
End Function ' Public Function GetAdds(Race As String, Stat As String)
' +=====================================================================+
' | This function returns the value of the specified single-value stat. |
' +---------------------------------------------------------------------+
Public Function GetBonus(Race As String, Bonus As String)
Dim Row
Dim Col
Row = NameRow(Race)
Col = NameCol(Bonus)
GetBonus = Worksheets("RCC").Cells(Row, Col).Value
End Function ' Public Function GetBonus(Race As String, Bonus As String)
' +=====================================================================+
' | This function returns the Column-Index in RCC of a named Statistic. |
' +---------------------------------------------------------------------+
Private Function NameCol(Stat As String)
Dim Col
If (NumStats <= 0) Then
If (Not (Initialize())) Then GoTo FAIL
End If
For Col = 1 To NumStats
If (Stat Like Stats(Col)) Then Exit For
Next
If (Col <= NumStats) Then
Col = StatCol(Col)
Else
FAIL: Col = 0
End If
NameCol = Col
End Function ' Private Function NameCol(Stat As String)
' +=======================================================================+
' | This routine returns the Row-Index of a named Race, in the RCC Table. |
' +-----------------------------------------------------------------------+
Private Function NameRow(Race As String)
Dim Row
If (NumRaces <= 0) Then
If (Not (Initialize())) Then GoTo FAIL
End If
For Row = 1 To NumRaces
If (Race Like Races(Row)) Then Exit For
Next
If (Row > NumRaces) Then
FAIL: Row = 0
End If
NameRow = Row
End Function ' Private Function NameRow(Race As String)
Public Function Calc(Here As Range)
Dim Parameter
Dim RetVal
' +-----------------------------------------------------------------------+
' | Lookup the parameter-name associated with 'Here'; do nothing if none. |
' +-----------------------------------------------------------------------+
Parameter = Worksheets("RCC").Cells(1, Here.Column)
If (Parameter = "") Then
RetVal = "" ' No associated Parameter - return NULL
Else
RetVal = CalcRow(Here.Row, Parameter)
End If
Calc = RetVal
End Function ' Public Function Calc(Here As Range)
' +===========================================================================+
' | This routine returns the value of a given Parameter for a specified Race. |
' +---------------------------------------------------------------------------+
Public Function CalcName(Race, Param)
Dim Row
Row = NameRow(CStr(Race))
If (Row > 0) Then
CalcName = CalcRow(Row, Param)
Else
FAIL: CalcName = ""
End If ' If ((Row > 0) And (Col > 0)) Then
End Function ' Public Function CalcName(Race, Param)
' +===========================================================================+
' | This Routine dispatches campaign-specific parametric-calculations...using |
' | the argument 'Here' to lookup the particulars in the RCC tables. In use, |
' | 'Here' should be the address of the current Cell in the spreadsheet, that |
' | is to have its value calcuated. Thus, Here.Row will specify the Race and |
' | Here.Column will indicate the campaign-parameter of interest. |
' +---------------------------------------------------------------------------+
' NOTE - An entry MUST be made in the SELECT statement of this routine for each
' Parameter to be calculated. The entry should consist of a string which
' matches the "heading" for that Parameter column.
' =============================================================================
Public Function CalcRow(Row, Param)
Dim TmpVal
Dim RetVal
Dim Parameter
' +-----------------------------------------------------+
' | Ensure that the global arrays have been initialized |
' +-----------------------------------------------------+
If (Row > NumRaces) Then
If (Not (Initialize())) Then
RetVal = ""
GoTo DONE
End If
End If
' +-----------------------------------------------------------------------+
' | Load the Delta() information for the Race associated with 'Here'. If |
' | there is no associated Race, LoadDelta() will fail, so we'll just not |
' | perform any calculations, in that case. |
' +-----------------------------------------------------------------------+
If (Not (LoadDelta(Row))) Then
RetVal = "" ' LoadDelta() FAILED - return NULL
GoTo DONE
End If
' +=================================================================+
' | Dispatch the parametric-processing - ADD PARAMETER-ENTRIES HERE |
' +-----------------------------------------------------------------+
Select Case (Param)
Case "Basic"
RetVal = SumDelta(Row)
Case "TLR Bane"
RetVal = TLR_Bane(Row)
Case "TLR Arena"
RetVal = Int(1.025 * TLR_Root(Row, 2.22) + 3)
If (Races(Row) = "Human") Then RetVal = 0
Case "TLR 10th"
RetVal = TLR_10th(Row)
Case "TLR Log"
RetVal = TLR_Log(Row)
Case "TLR Root"
RetVal = TLR_Root(Row, CDbl(2))
Case "TLR Cube"
RetVal = TLR_Root(Row, CDbl(3))
Case "Root " To ("Root" + Chr$(33))
TmpVal = InStr(1, Parameter, " ", 1)
RetVal = TLR_Root(Row, CDbl(Mid$(Parameter, TmpVal + 1)))
Case Else ' Unrecognized Parameter - return NULL
RetVal = ""
End Select ' Select Case (Parameter)
DONE:
CalcRow = RetVal
End Function ' Public Function CalcRow(Row,Param)
' +==========================================+
' | RCC-Costs for the TLR Nightbane Campaign |
' +------------------------------------------+
Private Function TLR_Bane(Row)
Dim RetVal
Select Case (Races(Row))
Case ""
RetVal = ""
Case "Human"
RetVal = 0
Case "Wampyr"
RetVal = 5
Case "Atlantean", "True Atlantean"
RetVal = 10
Case "Nightbane"
RetVal = 15
Case "Atlantean Nightbane"
RetVal = 20
Case "Guardian"
RetVal = 25
Case Else
RetVal = 50
End Select ' Select Case (Race)
TLR_Bane = RetVal
End Function ' Private Function TLR_Bane(Race As String)
' +==============================================================+
' | This routine simply returns the sum of the values in Delta() |
' +--------------------------------------------------------------+
Private Function SumDelta(Row)
Dim RetVal
Dim Index
For Index = 1 To BonIndex - 1
RetVal = RetVal + Delta(Index)
Next
SumDelta = Int(RetVal + 0.5)
End Function ' Private Function SumDelta(Race As Integer)
' +=======================================================+
' | RCC-Costs for the Zodiac Arena Campaign, 10th Version |
' +-------------------------------------------------------+
Private Function TLR_10th(Row)
Dim RetVal
RetVal = SumDelta(Row)
If (RetVal > 0) Then
RetVal = (RetVal / 10) + 0.5
End If
TLR_10th = Int(RetVal)
End Function ' Private Function TLR_10th(Race As Integer)
' +======================================================+
' | RCC-Costs for the Zodiac Arena Campaign, Log Version |
' +------------------------------------------------------+
Private Function TLR_Log(Row)
Dim RetVal
RetVal = SumDelta(Row)
If (RetVal > 0) Then
RetVal = Log(RetVal) + 1
End If
TLR_Log = Int(RetVal)
End Function ' Private Function TLR_Log(Race As Integer)
' +=======================================================+
' | RCC-Costs for the Zodiac Arena Campaign, Root Version |
' +-------------------------------------------------------+
Private Function TLR_Root(Row As Integer, Base As Double)
Dim RetVal
RetVal = SumDelta(Row)
If (RetVal > 0) Then
RetVal = Exp(Log(RetVal) / Base)
Else
RetVal = 0
End If
TLR_Root = Int(RetVal)
End Function ' Private Function TLR_Root(Race As Integer)