#349 Compile error on macs

[Anonymous]

I may be doing something wrong but I have Office 360 for the Mac and I keep getting compiling error.

this is what is reads as:

Sub SingleHideSpecifics()
Dim doapp As Boolean
Dim level As String
Dim LevelSpec As String
Dim LevelSpeckCheck As String
Dim LevelSearch As Integer
Dim LValue As Integer
Dim LClass As String
Dim LSheet As String
Dim classList As Range
On Error Resume Next

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

LName = Application.Caller

Set classList = Range("MasterClassList")

For Each s In ActiveSheet.Shapes
If s.Type = msoFormControl Then
    If s.FormControlType = xlDropDown Then
    dpName = s.Name
        If dpName = LName Then
            LCell = s.ControlFormat.LinkedCell
            LValue = Range(LCell).Value
            LClass = classList.Cells(LValue, 1).Value
            Exit For
        End If
    End If
End If
DoEvents
Next

    level = LClass
    level = Replace(level, " ", "")
    level = Replace(level, "-", "")
    LevelSpec = level & "Spec"
    LevelSpeckCheck = level & "SpeckCheck"

    If level = "" Then
        If doapp Then
            appDefault
        End If
    Else
        If level = "Ninja" Then
            LevelSpec = "RogueSpec"
            Range("RogueSpeckCheck").Value = True
        End If
        If level = "HellknightEnforcer" Then
            LevelSpec = "HellknightSpec"
            Range("HellknightSpeckCheck").Value = True
        End If
        Range(LevelSpec).EntireColumn.Hidden = False
        Range(LevelSpeckCheck).Value = True
    End If

If doapp Then
    appDefault
End If

End Sub

Sub AutoHideSpecifics()
Dim doapp As Boolean
Dim level As String
Dim LevelSpec As String
Dim LevelSpeckCheck As String
Dim LevelSearch As Integer
On Error Resume Next

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

Range("ClassSpec").Value = False
LName = Application.Caller

Set r = Range("ClassSpecCheck")
For n = 1 To r.Rows.Count
level = r.Cells(n, 1).Value
level = Replace(level, " ", "")
level = Replace(level, "-", "")
LevelSpec = level & "Spec"
LevelSpeckCheck = level & "SpeckCheck"

    If level = "" Then
        If doapp Then
            appDefault
        End If
        Exit Sub
    Else
        If r.Cells(n, 2).Value = True Or r.Cells(n, 3).Value = True Then
            If Range(LevelSpec).EntireColumn.Hidden = True Then
                Range(LevelSpec).EntireColumn.Hidden = False
            End If
            r.Cells(n, 2).Value = True
        Else
            If Range(LevelSpec).EntireColumn.Hidden = False Then
                Range(LevelSpec).EntireColumn.Hidden = True
            End If
        End If
    End If
    DoEvents
Next n

If doapp Then
    appDefault
End If

End Sub
Sub checkHideSpecifics()
Dim doapp As Boolean
Dim level As String
Dim LevelSpec As String
Dim LevelSpeckCheck As String
Dim r As Range
Dim n As Integer
On Error Resume Next

'Worksheets("Specifics").Select

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

Set r = Range("ClassSpecCheck")
For n = 1 To r.Rows.Count
    level = r.Cells(n, 1).Value
    level = Replace(level, " ", "")
    level = Replace(level, "-", "")
    LevelSpec = level & "Spec"
    LevelSpeckCheck = level & "SpeckCheck"

    If level = "" Then
        If doapp Then
            appDefault
        End If
        Exit Sub
    Else
        If level = "Ninja" Then
            LevelSpec = "RogueSpec"
            If Range("RogueSpeckCheck").Value = True Then
                Range("NinjaSpeckCheck").Value = True
            Else
                Range("NinjaSpeckCheck").Value = False
            End If
        End If
        If r.Cells(n, 2).Value = True Then
            If Range(LevelSpec).EntireColumn.Hidden = True Then
                Range(LevelSpec).EntireColumn.Hidden = False
            End If
        Else
            If Range(LevelSpec).EntireColumn.Hidden = False Then
                Range(LevelSpec).EntireColumn.Hidden = True
            End If
        End If
    End If
    DoEvents
Next n
Range("C13").Activate

If doapp Then
    appDefault
End If

End Sub
Sub ManualHideSpecifics()
Dim doapp As Boolean
Dim level As String
Dim LevelSpec As String
Dim LevelSpeckCheck As String
Dim r As Range
Dim n As Integer
Dim LValue As String
Dim LClass As String
Dim LSheet As String
Dim classList As Range
On Error Resume Next

'Worksheets("Specifics").Select

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

LName = Application.Caller
Set classList = Range("MasterClassList")

For Each s In ActiveSheet.Shapes
If s.Type = msoFormControl Then
    If s.FormControlType = xlCheckBox Then
    dpName = s.Name
        If dpName = LName Then
            LCell = s.ControlFormat.LinkedCell
            LValue = Range(LCell).Value
            Exit For
        End If
    End If
End If
DoEvents
Next

If LCell <> "" Then

    LevelSpec = Replace(LCell, "kCheck", "")
    LevelSpeckCheck = LCell

        If UCase(LValue) = "TRUE" Then
            If Range(LevelSpec).EntireColumn.Hidden = True Then
                Range(LevelSpec).EntireColumn.Hidden = False
            End If
        Else
            If Range(LevelSpec).EntireColumn.Hidden = False Then
                Range(LevelSpec).EntireColumn.Hidden = True
            End If
        End If

Else

Set r = Range("ClassSpecCheck")
For n = 1 To r.Rows.Count
    level = r.Cells(n, 1).Value
    level = Replace(level, " ", "")
    level = Replace(level, "-", "")
    LevelSpec = level & "Spec"
    LevelSpeckCheck = level & "SpeckCheck"

    If level = "" Then
        If doapp Then
            appDefault
        End If
        Exit Sub
    Else
        If level = "Ninja" Then
            LevelSpec = "RogueSpec"
            If Range("RogueSpeckCheck").Value = True Then
                Range("NinjaSpeckCheck").Value = True
            Else
                Range("NinjaSpeckCheck").Value = False
            End If
        End If
        If r.Cells(n, 2).Value = True Then
            If Range(LevelSpec).EntireColumn.Hidden = True Then
                Range(LevelSpec).EntireColumn.Hidden = False
            End If
        Else
            If Range(LevelSpec).EntireColumn.Hidden = False Then
                Range(LevelSpec).EntireColumn.Hidden = True
            End If
        End If
    End If
    DoEvents
Next n

End If
Range("C13").Activate

If doapp Then
    appDefault
End If

End Sub
Sub HideAllSpecifics()
Dim doapp As Boolean
Dim level As String
Dim LevelSpec As String
Dim LevelSpeckCheck As String
On Error Resume Next

Worksheets("Specifics").Select
doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

Range("ClassSpec").Value = False
Call checkHideSpecifics

If doapp Then
    appDefault
End If

End Sub
Sub ShowAllSpecifics()
Dim doapp As Boolean
Dim level As String
Dim LevelSpec As String
Dim LevelSpeckCheck As String
On Error Resume Next

Worksheets("Specifics").Select
doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

Range("ClassSpec").Value = True
Call checkHideSpecifics

If doapp Then
    appDefault
End If

End Sub
Sub HideAllPrestige()
Dim doapp As Boolean
Dim level As String
Dim LevelSpec As String
Dim LevelSpeckCheck As String
On Error Resume Next

Worksheets("Prestige").Select
doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

Range("ClassSpec").Value = False
Call checkHideSpecifics

If doapp Then
    appDefault
End If

End Sub
Sub ShowAllPrestige()
Dim doapp As Boolean
Dim level As String
Dim LevelSpec As String
Dim LevelSpeckCheck As String
On Error Resume Next

Worksheets("Prestige").Select
doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

Range("ClassSpec").Value = True
Call checkHideSpecifics

If doapp Then
    appDefault
End If

End Sub
Sub LevelOption()
Dim doapp As Boolean

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

Call SingleHideSpecifics
Worksheets("Level").Select

If doapp Then
    appDefault
End If

End Sub
Sub TestCheckPic()
Dim r As Range
Dim n As Integer
'ClassSpec
Set r = Range("ClassSpecCheck")
For n = 1 To r.Rows.Count
r.Cells(n, 2).Value = Range("ExportSheet!AG" & n + 3).Value
tmp = Range("ExportSheet!AF" & n + 3).Value
Next n
End Sub
Sub TestStyles()
Dim F As Integer
Dim i As Integer
Dim b As Integer
Dim StyleCount As Integer
Dim doapp As Boolean

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

Range("A:A").Clear
For F = 1 To 56 ' font colorindex
For i = 1 To 56 ' interior (fill) colorindex
For b = 1 To 56 ' top border colorindex
StyleCount = StyleCount + 1
Cells(StyleCount, 1).Select ' watch it run
Cells(StyleCount, 1).Value = StyleCount ' put style count in cell
Cells(StyleCount, 1).Font.ColorIndex = F ' set font color
Cells(StyleCount, 1).Interior.ColorIndex = i ' set fill color
With Cells(StyleCount, 1).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = b ' set border color
End With
Next b
Next i
Next F
If doapp Then
appDefault
End If
End Sub
Sub DeleteUnusedCustomNumberFormats()
'leo.heu...@get2net.dk, May 6. 2001
'Version 1.01
Dim Buffer As Object
Dim Sh As Object
Dim SaveFormat As Variant
Dim fFormat As Variant
Dim nFormat() As Variant
Dim xFormat As Long
Dim Counter As Long
Dim Counter1 As Long
Dim Counter2 As Long
Dim StartRow As Long
Dim EndRow As Long
Dim pPresent As Boolean
Dim NumberOfFormats As Long
Dim Answer
Dim Cell As Object
Dim DataStart As Long
Dim DataEnd As Long
Dim AnswerText As String
Dim ActWorkbookName As String
Dim BufferWorkbookName As String
Dim StyleCount As Integer
Dim doapp As Boolean

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

NumberOfFormats = 500
StartRow = 3 ' Do not alter this value
EndRow = 16384 ' For Excel 97 and 2000 set EndRow to 65536

ReDim nFormat(0 To NumberOfFormats)

AnswerText = "Do you want to delete unused custom formats " _
& "from the workbook?"
AnswerText = AnswerText & Chr(10) & "To get a list of used " _
& "and unused formats only, choose No."
Answer = MsgBox(AnswerText, 259)
If Answer = vbCancel Then GoTo Finito

On Error GoTo Finito
ActWorkbookName = ActiveWorkbook.Name
Workbooks.Add
BufferWorkbookName = ActiveWorkbook.Name

Set Buffer = Workbooks(BufferWorkbookName). _
ActiveSheet.Range("A3")
nFormat(0) = Buffer.NumberFormatLocal
Buffer.NumberFormat = "@"
Buffer.Value = nFormat(0)

Workbooks(ActWorkbookName).Activate

Counter = 1
Do
SaveFormat = Buffer.Value
DoEvents
SendKeys "{TAB 3}"
For Counter1 = 1 To Counter
SendKeys "{DOWN}"
Next Counter1
SendKeys "+{TAB}{HOME}'{HOME}+{END}" _
& "^C{TAB 4}{ENTER}"
Application.Dialogs(xlDialogFormatNumber). _
Show nFormat(0)
ActiveSheet.Paste Destination:=Buffer
Buffer.Value = Mid(Buffer.Value, 2)
nFormat(Counter) = Buffer.Value
Counter = Counter + 1
Loop Until nFormat(Counter - 1) = SaveFormat

ReDim Preserve nFormat(0 To Counter - 2)

Workbooks(BufferWorkbookName).Activate

Range("A1").Value = "Custom formats"
Range("B1").Value = "Formats used in workbook"
Range("C1").Value = "Formats not used"
Range("A1:C1").Font.Bold = True

For Counter = 0 To UBound(nFormat)
Cells(StartRow, 1).Offset(Counter, 0). _
NumberFormatLocal = nFormat(Counter)
Cells(StartRow, 1).Offset(Counter, 0).Value = _
nFormat(Counter)
Next Counter

Counter = 0
For Each Sh In Workbooks(ActWorkbookName).Worksheets
For Each Cell In Sh.UsedRange.Cells
fFormat = Cell.NumberFormatLocal
If Application.WorksheetFunction.CountIf _
(Range(Cells(StartRow, 2), Cells _
(EndRow, 2)), fFormat) = 0 Then
Cells(StartRow, 2).Offset(Counter, 0). _
NumberFormatLocal = fFormat
Cells(StartRow, 2).Offset(Counter, 0).Value _
= fFormat
Counter = Counter + 1
End If
Next Cell
Next Sh

xFormat = Range(Cells(StartRow, 2), Cells(EndRow, 2)). _
Find("").row - 2
Counter2 = 0
For Counter = 0 To UBound(nFormat)
pPresent = False
For Counter1 = 1 To xFormat
If nFormat(Counter) = Cells(StartRow, 2).Offset _
(Counter1, 0).NumberFormatLocal Then
pPresent = True
End If
Next Counter1
If pPresent = False Then
Cells(StartRow, 3).Offset(Counter2, 0). _
NumberFormatLocal = nFormat(Counter)
Cells(StartRow, 3).Offset(Counter2, 0).Value = _
nFormat(Counter)
Counter2 = Counter2 + 1
End If
Next Counter
With ActiveSheet.Columns("A:C")
.AutoFit
.HorizontalAlignment = xlLeft
End With
If Answer = vbYes Then
DataStart = Range(Cells(1, 3), _
Cells(EndRow, 3)).Find("").row + 1
DataEnd = Cells(DataStart, 3).Resize(EndRow, 1). _
Find("").row - 1
On Error GoTo Error_Out
For Each Cell In Range(Cells(DataStart, 3), _
Cells(DataEnd, 3)).Cells
Workbooks(ActWorkbookName).DeleteNumberFormat _
(Cell.NumberFormat)
Next Cell
End If
Finito:
Set Cell = Nothing
Set Sh = Nothing
Error_Out:
Set Buffer = Nothing
If doapp Then
appDefault
End If
End Sub

'Deletes All Styles (Except Normal) From Active Workbook
Sub ClearStyles()
Dim i&, Cell As Range, RangeOfStyles As Range
Dim doapp As Boolean

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
 'Add a temporary sheet
Sheets.Add before:=Sheets(1)
 'List all the styles
For i = 1 To ActiveWorkbook.Styles.Count
    [a65536].End(xlUp).Offset(1, 0) = ActiveWorkbook. _
    Styles(i).Name
Next
Set RangeOfStyles = Range(Columns(1).Rows(2), _
Columns(1).Rows(65536).End(xlUp))
For Each Cell In RangeOfStyles
    If Not Cell.Text Like "Normal" Then
        On Error Resume Next
        ActiveWorkbook.Styles(Cell.Text).Delete
        ActiveWorkbook.Styles(Cell.NumberFormat).Delete
    End If
Next Cell
 'delete the temp sheet
Application.DisplayAlerts = False
ActiveSheet.Delete
If doapp Then
    appDefault
End If

End Sub

Sub CampaignChange()
Dim doapp As Boolean
Dim r As Range
Dim n As Integer

Set r = Range("PFSCheck")

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

'For n = 1 To r.Rows.Count
    'r.Cells(n, 1).Value = Range("ExportSheet!AG" & n + 3).Value

If Range("PFSCheck") = True Then

    Range("C3").Value = 4 'XP
    Range("C5").Value = 3 'Point Buy
    Range("R5").Value = 3 'Traits
    Range("Y3").Value = 5 '1st Level Hit Points
    If Sheets("Source Books").Visible = False Then
        Sheets("Source Books").Visible = True
    End If
    If Sheets("Magic Equip").Visible = False Then
        Sheets("Magic Equip").Visible = True
    End If
    Sheets("Source Books").Select
    Call SourceSelectPFOGLBooks
    Call ResetMagicGear
    wsCS1.Shapes("PFSImg").ZOrder msoBringToFront
    DoEvents
Else
    Range("C3").Value = 2 'XP
    Range("C5").Value = 2 'Point Buy
    Range("R5").Value = 3 'Traits
    Range("Y3").Value = 1 '1st Level Hit Points
    wsCS1.Shapes("PFRPGImg").ZOrder msoBringToFront
    DoEvents
End If

Sheets("Options").Select

' Next n
If doapp Then
appDefault
End If
End Sub
Sub CopytoCustomClass()
Dim doapp As Boolean
Dim r As Range
Dim q As Range
Dim ca As Range
Dim skills As Range
Dim n As Integer
Dim ss As Integer
Dim classIndex As Integer
Dim classMatrix As Integer
Dim level As Integer
Dim className As String
Dim classtype As String
Dim casterType As String
Dim classSkillList As String
Dim skillName As String
Dim skillTarget As String

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

Set r = Range("ClassSelectIndex")
Set q = Range("ClassMatrix")
Set ca = Range("'Custom Class'!H21:H40")
classIndex = Range("'Custom Class'!AW14").Value
classtype = Range("CustomClassType").Value

Call ResetCustomClass
Range("'Custom Class'!AW14").Value = classIndex
Range("CustomClassType").Value = classtype

If classIndex <> 1 Then

    For n = 1 To r.Rows.Count

        If n < 100 Then

            If n = classIndex Then
                className = r.Cells(n, 4).Value
                classMatrix = r.Cells(n, 2).Value
                Range("'Custom Class'!E2").Value = className & " Copy"
                If classtype = "Archetype" Then
                    Range("CustomClassBase").Value = className
                End If
                Range("'Custom Class'!E3").Value = q.Cells(classMatrix, 3).Value 'HD
                Range("'Custom Class'!E4").Value = q.Cells(classMatrix + 1, 3).Value 'Skill Pointd
                casterType = q.Cells(classMatrix, 5).Value 'Caster
                Range("'Custom Class'!D20").Value = q.Cells(classMatrix + 1, 5).Value 'Fort Saves
                Range("'Custom Class'!E20").Value = q.Cells(classMatrix + 2, 5).Value 'Ref Saves
                Range("'Custom Class'!F20").Value = q.Cells(classMatrix + 3, 5).Value 'Will Saves
                Range("'Custom Class'!C20").Value = q.Cells(classMatrix + 4, 5).Value 'BAB
                Select Case casterType
                    Case "A"
                        Range("'Custom Class'!J3").Value = "Arcane" 'Caster
                    Case "D"
                        Range("'Custom Class'!J3").Value = "Divine" 'Caster
                    Case Else
                        Range("'Custom Class'!J3").Value = "None" 'Caster
                End Select

                If casterType <> "N" Then
                    Range("'Custom Class'!J4").Value = className 'Spells
                    Range("'Custom Class'!N3").Value = q.Cells(classMatrix + 6, 5).Value 'Spell Stat
                Else
                    Range("'Custom Class'!J4").Value = "" 'Spells
                    Range("'Custom Class'!N3").Value = "" 'Spell Stat
                End If

                classSkillList = q.Cells(classMatrix + 2, 6).Value 'Class Skills
                Set skills = Range("CustomClassSkillsLists")

                For ss = 1 To skills.Rows.Count
                    skillName = skills.Cells(ss, 1).Value
                    If skillName <> "" Then
                        Num = InStr(classSkillList, skillName)
                        If Num > 0 Then
                            skillTarget = skills.Cells(ss, 7).Value
                            Range(skillTarget) = "Yes"
                        End If
                    End If
                    DoEvents
                Next ss

                For level = 1 To 20
                    For c = 0 To 9
                        ca.Cells(level, (5 * c) + 1).Value = q.Cells(c + classMatrix, level + 7).Value
                    Next c
                    If level = 1 Then
                        i = 9
                        For cd = 0 To 9
                            If ca.Cells(level, (5 * i) + 1).Value = "" Then
                                ca.Cells(level, (5 * i) + 1).Value = "Weapons and Armor Class"
                                cd = 9
                            End If
                            i = i - 1
                            DoEvents
                        Next cd
                    End If
                    DoEvents
                Next level
            End If
        End If
        DoEvents
    Next n

End If

If doapp Then
    appDefault
End If

End Sub
Sub CopytoCustomClassfromArchetype()
Dim doapp As Boolean
Dim r As Range
Dim ca As Range
Dim rs As Range
Dim skills As Range
Dim q As Range
Dim ci As Range
Dim n As Integer
Dim m As Integer
Dim ss As Integer
Dim classIndex As Integer
Dim classPix As Integer
Dim baseIndex As Integer
Dim level As Integer
Dim className As String
Dim classtype As String
Dim casterType As String
Dim classSkillList As String
Dim skillName As String
Dim skillTarget As String
Dim spellStat As String

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

Set r = Range("'Archetype Definitions'!$B$29:$B$430")
Set ca = Range("'Custom Class'!H21:H40")
Set rs = Range("'Custom Class'!AY50:AY64")
Set q = Range("ClassMatrix")
Set ci = Range("ClassSelectIndex")
classtype = Range("CustomClassType").Value
classPix = Range("'Custom Class'!AY46").Value
classIndex = Range("'Custom Class'!AZ46").Value
classMatrix = Range("'Custom Class'!BB46").Value

Call ResetCustomClass
Range("'Custom Class'!AY46").Value = classPix
Range("CustomClassType").Value = "Archetype"

If classIndex <> 1 Then
    n = classPix
    className = r.Cells(n, 2).Value
    classBase = r.Cells(n, 1).Value
    Range("'Custom Class'!E2").Value = className & " Copy"
    Range("CustomClassBase").Value = classBase
    archHD = r.Cells(n, 4).Value 'HD
    If archHD = "" Then
        archHD = q.Cells(classMatrix, 3).Value 'HD
    End If
    skillP = r.Cells(n, 5).Value 'Skill Points
    If skillP = "" Then
        skillP = q.Cells(classMatrix + 1, 3).Value 'HD
    End If
    Range("'Custom Class'!E3").Value = archHD 'HD
    Range("'Custom Class'!E4").Value = skillP 'Skill Points
    casterType = r.Cells(n, 7).Value 'Caster
    Range("'Custom Class'!D20").Value = q.Cells(classMatrix + 1, 5).Value 'Fort Saves
    Range("'Custom Class'!E20").Value = q.Cells(classMatrix + 2, 5).Value 'Ref Saves
    Range("'Custom Class'!F20").Value = q.Cells(classMatrix + 3, 5).Value 'Will Saves
    Range("'Custom Class'!C20").Value = r.Cells(n, 11).Value 'BAB
    If Range("'Custom Class'!C20").Value = "" Then
        Range("'Custom Class'!C20").Value = q.Cells(classMatrix + 4, 5).Value 'BAB
    End If
    Range("'Custom Class'!AY48").Value = r.Cells(n, 16).Value 'Race Reg?
    If casterType = "" Then
        casterType = q.Cells(classMatrix, 5).Value 'Caster
    End If
    If casterType = "" Then
        casterType = "N"
    End If
    Select Case casterType
        Case "A"
            Range("'Custom Class'!J3").Value = "Arcane" 'Caster
        Case "D"
            Range("'Custom Class'!J3").Value = "Divine" 'Caster
        Case Else
            Range("'Custom Class'!J3").Value = "None" 'Caster
    End Select

    If casterType <> "N" Then
        Range("'Custom Class'!J4").Value = classBase 'Spells
        spellStat = r.Cells(n, 13).Value 'Spell Stat
        If spellStat = "" Then
            spellStat = q.Cells(classMatrix + 6, 5).Value 'Spell Stat
        End If
        Range("'Custom Class'!N3").Value = spellStat
    Else
        Range("'Custom Class'!J4").Value = "" 'Spells
        Range("'Custom Class'!N3").Value = "" 'Spell Stat
    End If

    classSkillList = r.Cells(n, 14).Value 'Class Skills
    Set skills = Range("CustomClassSkillsLists")

    If classSkillList = "" Then
        classSkillList = q.Cells(classMatrix + 2, 6).Value 'Class Skills
        Set skills = Range("CustomClassSkillsLists")
    End If

    If classSkillList <> "" Then
    For ss = 1 To skills.Rows.Count
        skillName = skills.Cells(ss, 1).Value
        If skillName <> "" Then
            Num = InStr(classSkillList, skillName)
            If Num > 0 Then
                skillTarget = skills.Cells(ss, 7).Value
                Range(skillTarget) = "Yes"
            End If
        End If
        DoEvents
    Next ss
    End If

    j = 18
    c = 0
    i = 1
    For level = 1 To 200
        ca.Cells(i, (5 * c) + 1).Value = r.Cells(n, level + j).Value
        c = 1 + c
        If c > 9 Then
            c = 0
            i = i + 1
        End If
        DoEvents
    Next level

    j = 220
    c = 1
    For t = 220 To 234
        rs.Cells(c, 1).Value = r.Cells(n, t).Value
        c = 1 + c
        DoEvents
    Next t

    For level = 1 To 20
        For c = 0 To 9
            If ca.Cells(level, (5 * c) + 1).Value = "" Then
                ca.Cells(level, (5 * c) + 1).Value = q.Cells(c + classMatrix, level + 7).Value
            End If
            DoEvents
        Next c
        If level = 1 Then
            i = 9
            For cd = 0 To 9
                If ca.Cells(level, (5 * i) + 1).Value = "" Then
                    'ca.Cells(level, (5 * i) + 1).Value = "Weapons and Armor Class"
                    cd = 9
                End If
                i = i - 1
                DoEvents
            Next cd
        End If
        DoEvents
    Next level

End If

If doapp Then
    appDefault
End If

End Sub
Sub CopyRaceData()
Dim doapp As Boolean
Dim r As Range
Dim n As Integer
Dim RaceIndex As Integer
Dim raceName As String

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

Set r = Range("RaceCopyList")
RaceIndex = Range("'Custom Race'!C2").Value

Call ResetCustomRace
Range("'Custom Race'!C2").Value = RaceIndex

If RaceIndex <> 1 Then

    For n = 1 To r.Rows.Count

    If n < 60 Then

    If n = 1 Then
        raceName = r.Cells(n, 1 + RaceIndex).Value
    End If

    If raceName <> "" Then
        Range("'Custom Race'!C" & 4 + n).Value = r.Cells(n, 1 + RaceIndex).Value
    End If
    End If
    DoEvents
    Next n

End If

If doapp Then
    appDefault
End If

End Sub
Sub CopyRaceTemplateData()
Dim doapp As Boolean
Dim r As Range
Dim n As Integer
Dim RaceIndex As Integer
Dim TemplateName As String
Dim raceName As String

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

Set r = Range("RaceTemplates")
TemplateName = Range("Customization!AF46").Value 'Template Name

Call ResetRaceTemplates
Range("Customization!AF46").Value = TemplateName

If TemplateName <> "" Then

    For n = 1 To r.Rows.Count

    If n < 42 Then
        raceName = r.Cells(n, 1).Value
        If raceName = TemplateName Then
            Range("Customization!AF48").Value = r.Cells(n, 3).Value
            Range("Customization!AF49").Value = r.Cells(n, 4).Value

            For z = 5 To 32
                Range("Customization!AD" & 46 + z).Value = r.Cells(n, z).Value
            Next z
            n = r.Rows.Count - 1
        End If

    End If
    DoEvents
    Next n

End If

If doapp Then
    appDefault
End If

End Sub
Sub CopyMagicItemData()
Dim doapp As Boolean
Dim r As Range
Dim n As Integer
Dim MagicItemPick As Integer
Dim MagicItemPickIndex As Integer
Dim itemName As String
Dim freeLine As Integer

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

MagicItemPick = Range("MagicItemPick")
MagicItemPickIndex = Range("MagicItemPickIndex")

Set r = Range("MagicItemsFullList")
Set q = Range("'Magic Equip'!Z4")

If MagicItemPickIndex > 1 Then
freeLine = 1
    For i = 1 To 15
        itemName = q.Cells(i, 1).Value
        If itemName = "" Then
            freeLine = i
            i = 15
        End If
        DoEvents
    Next i

    n = MagicItemPickIndex

    For z = 1 To 59
        q.Cells(freeLine, z).Value = r.Cells(n, z).Value
        DoEvents
    Next z

End If

Range("'Magic Equip'!AB4:AE18").Value = ""
Range("'Magic Equip'!AW4:AX18").Value = ""
Range("'Magic Equip'!BB4:BD18").Value = ""
Range("'Magic Equip'!BI4:BL18").Value = ""
Range("'Magic Equip'!BN4:BN18").Value = ""
Range("'Magic Equip'!BR4:BW18").Value = ""
Range("'Magic Equip'!BY4:BY18").Value = ""

If doapp Then
    appDefault
End If

End Sub
Sub RemoveNames()
Dim myREF As Integer, myHero As Integer, mySpell As Integer, myOptions As Integer
Dim myNum As Integer, myNumR As Integer, myNumL As Integer, mySheet As Integer
Dim myData As Integer, myClean As Integer, myUnder As Integer, myMisc As Integer
Dim newName As String
Dim doapp As Boolean
On Error Resume Next

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If


For Each n In ActiveWorkbook.Names
    myData = InStr(UCase(n.Value), "_DATA")
    myREF = InStr(UCase(n.Value), "#REF")
    myHero = InStr(UCase(n.Value), UCase("Heroforge"))
    mySpell = InStr(UCase(n.Value), UCase("SpellForge"))
    myOptions = InStr(UCase(n.Name), UCase("Options Info"))
    myMisc = InStr(UCase(n.Value), UCase("#N/A"))
    mySheet = InStr(UCase(n.Name), UCase("BulletsList"))
    myClean = InStr(UCase(n.Value), UCase("YAPCG"))
    myTable = InStr(UCase(n.Value), UCase("tbl"))
    myTable = myTable + InStr(UCase(n.Name), UCase("tbl"))
    myUnder = InStr(UCase(n.Value), UCase("_"))
    myFile = InStr(UCase(n.Value), UCase("F:\"))
    myNumR = InStr(n.Value, "]")
    myNumL = InStr(n.Value, "'")
    newName = ""
    oldName = n.Name
    myNum = myData + myREF + myHero + mySpell + myOptions + myClean + myTable + mySheet + myMisc + myFile
    If myNum > 0 Then
        n.Delete
    ElseIf myUnder > 0 Then
        Stop
    ElseIf myNumL > 0 And myNumR > 0 Then
        newName = Mid(n.Value, 1, myNumL) + Mid(n.Value, myNumR + 1, Len(n.Value))
        n.Value = newName
    ElseIf mySheet > 0 Then
        myNumR = InStr(n.Name, "!")
        newName = Right(n.Name, (Len(n.Name) - myNumR))
        n.Name = newName
    End If
    DoEvents
Next n

If doapp Then
    appDefault
End If

End Sub
Sub ReNameFCP()
Dim myFCP As Integer
Dim myFCL As Integer
Dim myData As Integer
Dim newName As String
Dim oldName As String
On Error Resume Next

For Each n In ActiveWorkbook.Names
    myFCP = InStr(UCase(n.Name), "FCP")
    myFCL = InStr(UCase(n.Name), "FCL")
    myFCEx = InStr(UCase(n.Name), "FCEx")
    newName = ""
    oldName = n.Name
    newName = Right(oldName, Len(oldName) - 3)
    oldValue = n.Value

    If myFCL > 0 Or myFCP > 0 Then
    'Stop
    End If

    If myFCL > 0 And myFCL < 2 Then
        n.Name = "FavClaLvl" & newName
        'n.Add Name:="FavClaPic", RefersTo:=oldValue
    ElseIf myFCP > 0 And myFCP < 2 Then
        n.Name = "FavClaPic" & newName
    ElseIf myFCEx > 0 Then
        n.Delete
    End If
    DoEvents
Next n

End Sub
Sub CheckNamedRange()
Dim myNum As Integer
Dim newName As String
Dim doapp As Boolean
On Error Resume Next

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

sheetName = "CheckNameRange"
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = sheetName
ActiveWorkbook.Worksheets(sheetName).Activate
ActiveSheet.Range("A3").Activate

myNum = 1
For Each n In ActiveWorkbook.Names

newName = "A" & CStr(myNum + 3)
ActiveSheet.Range(newName).Activate
ActiveCell.Value = n.Name
ActiveCell.Offset(0, 1).Value = "'" & n.RefersToRange.Address

ActiveCell.Offset(0, 3).Value = "'" & n.Value
myNum = 1 + myNum
DoEvents

Next n

If doapp Then
    appDefault
End If

End Sub
Sub appVersionFull()
Dim versionType As String

versionType = "Full"
Call NextVersion(versionType)

End Sub
Sub appVersionSub()
Dim versionType As String

versionType = "Sub"
Call NextVersion(versionType)

End Sub
Sub appVersionError()
Dim versionType As String

versionType = "Error"
Call NextVersion(versionType)

End Sub
Sub appVersionMinor()
Dim versionType As String

versionType = "Minor"
Call NextVersion(versionType)

End Sub

Sub NextVersion(versionType As String)
Dim sCFVersion As String
Dim NewVersion As String
Dim workVersion As String
Dim Prime As Integer
Dim Secd As Integer
Dim Thrd As Integer
Dim Frth As Integer
Dim Num As Integer
Dim sizeV As Integer

sCFVersion = Range("Splash!A26").Value
sizeV = Len(sCFVersion)
workVersion = Right(sCFVersion, sizeV - 1)

Num = InStr(workVersion, ".")
Prime = Left(workVersion, Num)
sizeV = Len(workVersion)
workVersion = Right(workVersion, sizeV - Num)
Num = InStr(Num, workVersion, ".")

Secd = Left(workVersion, Num)
sizeV = Len(workVersion)
workVersion = Right(workVersion, sizeV - Num)
Num = InStr(workVersion, ".")

Thrd = Left(workVersion, Num)
sizeV = Len(workVersion)
workVersion = Right(workVersion, sizeV - Num)
Num = InStr(Num, workVersion, ".")

If Num = 0 Then
    Frth = workVersion
Else
    Frth = Left(workVersion, Num)
End If

Select Case versionType
    Case "Full"
        Prime = Prime + 1
        Secd = 0
        Thrd = 0
        Frth = 0
    Case "Sub"
        Secd = Secd + 1
        Thrd = 0
        Frth = 0
    Case "Minor"
        Thrd = Thrd + 1
        Frth = 0
    Case "Error"
        Frth = Frth + 1
End Select

sCFVersion = "v" & CStr(Prime) & "." & CStr(Secd) & "." & CStr(Thrd) & "." & CStr(Frth)

Range("Splash!A26").Value = sCFVersion
Range("ExportSheet!A2").Value = sCFVersion

End Sub
Sub setColor()
Dim usrColorCode As Boolean
Dim doapp As Boolean

doapp = (Application.Cursor <> xlWait)
If doapp Then
    appWait
End If

usrColorCode = Range("usrColorCode").Value

If usrColorCode Then
    Call colorCode("'Character Sheet I'!AE15:AJ17,AL15:AO17", "teal")
    Call colorCode("'Character Sheet I'!AE19:AJ21,AL19:AO21,AE23:AJ25,AL23:AO25,AE27:AJ29,AL27:AO29", "green")
    Call colorCode("'Character Sheet I'!AE31:AJ33,AL31:AO33", "blue")
    Call colorCode("'Character Sheet I'!AE35:AJ37,AL35:AO37,C55:K57,M55:Q57,C59:K61,M59:Q61,C66:N68,P66:AE68", "orange")
    Call colorCode("'Character Sheet I'!C41:M43,O41:Q43,C45:M47,O45:Q47,C49:M51,O49:Q51", "yellow")
    Call addLines("'Character Sheet I'!AE15:AJ17,AE19:AJ21,AE23:AJ25,AE27:AJ29,AE31:AJ33,AE35:AJ37,C55:K57,C59:K61,C66:N68,C41:M43,C45:M47,C49:M51")
Else
    Call colorCode("'Character Sheet I'!AE15:AJ17,AE19:AJ21,AE23:AJ25,AE27:AJ29,AE31:AJ33,AE35:AJ37,C55:K57,C59:K61,C66:N68,C41:M43,C45:M47,C49:M51", "black")
    Call colorCode("'Character Sheet I'!AL15:AO17,AL19:AO21,AL23:AO25,AL27:AO29,AL31:AO33,AL35:AO37,M55:Q57,M59:Q61,P66:AE68,O41:Q43,O45:Q47,O49:Q51", "white")
End If

Range("A1").Select
If doapp Then
    appDefault
End If

End Sub
Function colorCode(cellRef As String, color As String)

Select Case color
    Case "teal"
        Range(cellRef).Interior.color = RGB(51, 204, 204)
        Range(cellRef).Interior.Pattern = xlSolid
        Range(cellRef).Font.color = vbWhite
    Case "green"
        Range(cellRef).Interior.color = RGB(0, 128, 0)
        Range(cellRef).Interior.Pattern = xlSolid
        Range(cellRef).Font.color = vbWhite
    Case "blue"
        Range(cellRef).Interior.color = RGB(0, 120, 204)
        Range(cellRef).Interior.Pattern = xlSolid
        Range(cellRef).Font.color = vbWhite
    Case "orange"
        Range(cellRef).Interior.color = RGB(255, 153, 0)
        Range(cellRef).Interior.Pattern = xlSolid
        Range(cellRef).Font.color = vbBlack
    Case "yellow"
        Range(cellRef).Interior.color = RGB(255, 204, 0)
        Range(cellRef).Interior.Pattern = xlSolid
        Range(cellRef).Font.color = vbBlack
    Case "black"
        Range(cellRef).Interior.color = RGB(0, 0, 0)
        Range(cellRef).Interior.Pattern = xlSolid
        Range(cellRef).Font.color = vbWhite
    Case Else
        Range(cellRef).Interior.ColorIndex = 1
        Range(cellRef).Interior.Pattern = xlNone
        Range(cellRef).Font.color = vbBlack
End Select

End Function
Sub addLines(cellRef As String)
Range(cellRef).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

[Anonymous]

I have modified Pathfinder-sCoreForge-7.4.0.1 to remove all errors with regards to compiling and thus crashing code that stops the sheet being useable.

If the original developer would like to drop me an e-mail at david AT vega DOT id DOT au then I would be happy to inform / discuss the solution.

I am currently testing the sheet to see if it works as it should.