MH Ref 7.8.4 VBA code

Option Explicit
Dim stTime As Double, usrSortKey As String
Sub BonusLuckWeekend()
' Copypasta from ShieldToggle()
Dim filterflag As Boolean, stTime#
stTime = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Call TrapReset("Luck")
Application.Calculate
usrSortKey = Sheets("Bestsetup").Cells(22, Sheets("bestSetup").ListObjects("Trbstable").Sort.SortFields.Item(1).Key.Column).Value
If Not usrSortKey Like "Per*" Then usrSortKey = vbNullString
Call SortLocation(usrSortKey)

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Debug.Print "ShieldToggle: " & Format(Timer - stTime, "##0.0000") & " seconds total"
Exit Sub
End Sub
Sub ShieldToggle()
' Written 3/31/11 by Ben Hauch
' Last updated 5/5/11 by Ben Hauch
Dim filterflag As Boolean, stTime#
stTime = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Call TrapReset("Luck")
usrSortKey = Sheets("Bestsetup").Cells(22, Sheets("bestSetup").ListObjects("Trbstable").Sort.SortFields.Item(1).Key.Column).Value
If Not usrSortKey Like "Per*" Then usrSortKey = vbNullString
Call SortLocation(usrSortKey)

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Debug.Print "ShieldToggle: " & Format(Timer - stTime, "##0.0000") & " seconds total"
Exit Sub
End Sub
Sub AssignMousesNamePowerType()
' Patterned after GetMiceNames as written by Ben Hauch and updated by RJS
' Last updated by Ben Hauch on 02/02/12

stTime = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
Dim CheeseCol%, i%, j%, AutoFCriteria() As Variant, filterflag As Boolean, tmp, tmp2, tmp3, tmp4
Dim aMice() As Variant, MiceTbl() As Variant, EventMice As Boolean, rMice() As Variant

' Remove all mice, subgroups, and catch rates from the sheet
If Sheets("BestSetup").ListObjects("TrBsTable").Sort.SortFields.Count > 0 Then usrSortKey = Sheets("Bestsetup").Cells(22, Sheets("bestSetup").ListObjects("Trbstable").Sort.SortFields.Item(1).Key.Column).Value
Sheets("BestSetup").Columns("K:BA").Delete

' Reset to Common cheese if changing locations
If Range("LocationIndex").Value <> Range("OldLocation") Then
    Range("CheeseIndex").Value = 1
    Range("OldLocation").Value = Range("LocationIndex").Value
    End If

' Determine the proper lookup column to use on M_cheese sheet
CheeseCol = Application.VLookup(Range("LocationName").Value, Range("L_Cheese[#Data]"), _
             13, False) + Range("CheeseIndex").Value + 3

' Perform the autofilter to enable properly sizing rMice()
Sheets("M_cheese").ListObjects("M_attraction").Range.AutoFilter field:=CheeseCol, Criteria1:="<>"
If Range("EventIndex").Value = 2 Then
        EventMice = False
        Sheets("M_cheese").ListObjects("M_attraction").Range.AutoFilter field:=2, Criteria1:="<>Event Mice"
        Else: EventMice = True
    End If

' Filter out the unwanted mice
aMice = Range("M_attraction").Value
MiceTbl = Range("Mice[[#All],[Mice]:[Tactical]]").Value

If Not UBound(aMice) = UBound(MiceTbl) - 1 Then GoTo SubExit 'Test to ensure equality without using lookups
On Error GoTo SubExit
ReDim rMice(1 To 4, 1 To Range("M_attraction[Mice]").SpecialCells(xlCellTypeVisible).Count)
On Error GoTo 0
Let j = 1
For i = 1 To UBound(aMice)
    If Not IsEmpty(aMice(i, CheeseCol)) Then        'Mouse attractable?
        If Not EventMice Then                       'Ignore Event mice?
            If Not aMice(i, 2) = "Event Mice" Then      'Is this an event mouse?
                rMice(1, j) = aMice(i, 1)               'Ok not an event mouse
                rMice(2, j) = MiceTbl(i + 1, 3)
                rMice(3, j) = MiceTbl(i + 1, 6)
                rMice(4, j) = aMice(i, CheeseCol)       'Get attraction weighting factor
                j = j + 1
            End If
        Else                                        'Don't ignore Event mice
            rMice(1, j) = aMice(i, 1)
            rMice(2, j) = MiceTbl(i + 1, 3)
            rMice(3, j) = MiceTbl(i + 1, 6)
            rMice(4, j) = aMice(i, CheeseCol)
            j = j + 1
        End If
    End If
Next i

' Has the user enabled some custom Trap/Base/Charm/qualifier filters?  Preserve them!
' Need have selected a cell in the filtered table for the call to work. <---Dumb but true D:<
Sheets("BestSetup").Range("B22").Select
If Sheets("BestSetup").FilterMode Then
    filterflag = True
    AutoFCriteria = GetAutofilterNames
    Sheets("BestSetup").AutoFilterMode = False
    Sheets("BestSetup").Range("TrBsTable").AutoFilter
    End If

' Write attracted mice & total attraction rate
Sheets("BestSetup").Range(Cells(5, 11), Cells(8, 10 + UBound(rMice, 2))).Value = rMice
Sheets("BestSetup").Range("totAR").Value = Application.Sum(Sheets("BestSetup").Range(Cells(8, 11), Cells(8, 10 + UBound(rMice, 2))))

' Sort the attracted mice by Mouse Power (could use flag to sort by attraction rate)
Sheets("BestSetup").Sort.SortFields.Clear
Sheets("BestSetup").Sort.SortFields.Add Key:=Range("K7:BA7"), _
    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With Sheets("BestSetup").Sort
    .SetRange Range("K5:BA8")
    .Header = xlNo
    .Orientation = xlLeftToRight
    .Apply
End With

'Load sorted rMice array into memory
rMice = Sheets("BestSetup").Range(Cells(5, 11), Cells(7, 10 + UBound(rMice, 2))).Value

'Perform location-based stat increases before doing catch rate calculations
Select Case Application.Index(Range("Locations29[Locations]"), Range("LocationIndex"))
    Case "Seasonal Garden - Spring", "Seasonal Garden - Summer", "Seasonal Garden - Winter"
        If Range("PrevLoc") <> "Seas" Then Call SeasonalBoost
        Range("PrevLoc").Value = "Seas"
    Case "Seasonal Garden - Fall"
        If Range("Prevloc") <> "SeasF" Then
            Call SeasonalBoost
            Call SoulXLuckBoost("Seasonal")
        End If
        Range("PrevLoc").Value = "Seasf"
    Case "Derr Dunes", "Nerg Plains", "Elub Shore", "Cape Clawed"
        If Range("CharmName").Value = "Tribal Power" Then
            Call TrapReset("Power")
        ElseIf Range("PrevLoc") <> "Trib" Then
            Call TikiBoost
        End If
        Range("PrevLoc").Value = "Trib"
    Case "Chocolate Factory 2011", "Chocolate Factory 2012"
        If Application.IsEven(Range("CheeseIndex")) Then 'Need to use Dark chocolate charm
            Call CharmMods
            If Range("K27").Value = vbNullString Then Call CatchRateColumns(rMice, MiceTbl, Range("LocationName").Value)
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.0000") & " sec"
            GoTo SubExit
        ElseIf Range("PrevCharm").Value = "DChoco" Then 'Last charm was chocolate, but we switched cheese to no chocolate
            Range("CharmIndex").Value = Application.Match("None", Range("CharmNames"), 0) 'clear charms
            Range("OldCharm").Value = 999 'Trigger guaranteed recalculation
            Call CharmMods
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.0000") & " sec"
            GoTo SubExit
            End If
    Case "Festive Comet 2011"
        If (Range("CheeseIndex").Value = 4) Then ' Need Winter Charm
            Call CharmMods
            If Range("K27").Value = vbNullString Then Call CatchRateColumns(rMice, MiceTbl, Range("LocationName").Value)
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.0000") & " sec"
            GoTo SubExit
        ElseIf Range("prevcharm").Value = "Winter" Then
            Range("CharmIndex").Value = Application.Match("None", Range("CharmNames"), 0)
            Range("OldCharm").Value = 999
            Call CharmMods
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.0000") & " sec"
            GoTo SubExit
        End If
    Case "Year of the Dragon Festival"
        If (((Range("CheeseIndex").Value - 1) Mod 4) > 0) Then  ' Need to equip a charm...
            Call CharmMods
            If Range("K27").Value = vbNullString Then Call CatchRateColumns(rMice, MiceTbl, Range("LocationName").Value)
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.0000") & " sec"
            GoTo SubExit
        ElseIf ((Range("PrevCharm").Value = "Fcracker") Or (Range("Prevcharm").Value = "Npoop") Or (Range("PrevCharm").Value = "DBreath")) Then
            Range("CharmIndex").Value = Application.Match("None", Range("Charmnames"), 0)
            Range("OldCharm").Value = 999
            Call CharmMods
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.0000") & " sec"
            GoTo SubExit
        End If
    Case "Snow Fortress - Gateway", "Snow Fortress - Courtyard", "Snow Fortress - Keep"
        If (Range("CheeseIndex").Value = 2) Then ' Need Winter Charm
            Call CharmMods
            If Range("K27").Value = vbNullString Then Call CatchRateColumns(rMice, MiceTbl, Range("LocationName").Value)
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.0000") & " sec"
            GoTo SubExit
        ElseIf Range("prevcharm").Value = "Winter" Then
            Range("CharmIndex").Value = Application.Match("None", Range("CharmNames"), 0)
            Range("OldCharm").Value = 999
            Call CharmMods
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.0000") & " sec"
            GoTo SubExit
        End If
    Case "Terrortories - Corn Maze", "Terrortories - Haunted Manor", "Terrortories - Pumpkin Patch"
        If Range("PrevLoc").Value <> "Terror" Then Call SoulXLuckBoost("Terror")
        Range("PrevLoc").Value = "Terror"
        If (((Range("CheeseIndex").Value - 1) \ 4) > 0) Then
            ' Using a Spookified bait, enforce charm
            Call CharmMods
            If Range("K27").Value = vbNullString Then Call CatchRateColumns(rMice, MiceTbl, Range("LocationName").Value)
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.000") & " sec"
            GoTo SubExit
        ElseIf Range("PrevCharm").Value = "Spooky" Then ' Last Charm was Spooky Charm, but we switched cheese to non-spooky bait
            Range("Charmindex").Value = Application.Match("None", Range("Charmnames"), 0)   ' so clear the charm
            Range("OldCharm").Value = 999   ' Trigger stats recalculation
            Call CharmMods
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.000") & " sec"
            GoTo SubExit
        End If
    Case "Muridae Market"
        If Application.IsEven(Range("CheeseIndex")) Then
            Call CharmMods
            If Range("K27").Value = vbNullString Then Call CatchRateColumns(rMice, MiceTbl, Range("LocationName").Value)
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.0000") & " sec"
            GoTo SubExit
        ElseIf Range("PrevCharm").Value = "Artisan" Then
            Range("CharmIndex").Value = Application.Match("None", Range("Charmnames"), 0)
            Range("OldCharm").Value = 999
            Call CharmMods
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.0000") & " sec"
            GoTo SubExit
        End If
    Case "Slushy Shoreline"
        If Application.IsEven(Range("CheeseIndex")) Then
            Call CharmMods
            If Range("K27").Value = vbNullString Then Call CatchRateColumns(rMice, MiceTbl, Range("LocationName").Value)
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.0000") & " sec"
            GoTo SubExit
        ElseIf Range("PrevCharm").Value = "SoftServe" Then
            Range("CharmIndex").Value = Application.Match("None", Range("Charmnames"), 0)
            Range("OldCharm").Value = 999
            Call CharmMods
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.0000") & " sec"
            GoTo SubExit
        End If
    Case "Crystal Library"
        If Application.IsEven(Range("CheeseIndex")) Then
            Call CharmMods
            If Range("K27").Value = vbNullString Then Call CatchRateColumns(rMice, MiceTbl, Range("LocationName").Value)
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.0000") & " sec"
            GoTo SubExit
        ElseIf Range("PrevCharm").Value = "CScholar" Then
            Range("CharmIndex").Value = Application.Match("None", Range("Charmnames"), 0)
            Range("OldCharm").Value = 999
            Call CharmMods
            Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.0000") & " sec"
            GoTo SubExit
        End If
    Case Else
        If Range("PrevLoc").Value = "Seas" Then
            Range("PrevLoc").Value = ""
            Call TrapReset("Power")
            GoTo SubExit
            End If
        If (Range("PrevLoc").Value = "Trib") Or (Range("PrevLoc").Value = "Seasf") Or (Range("PrevLoc").Value = "Terror") Then
            Range("PrevLoc").Value = ""
            Call TrapReset("All")
            GoTo SubExit
            End If
End Select

'Perform Catch Rate calculations
Call CatchRateColumns(rMice, MiceTbl, Range("LocationName").Value)

' Create ranking columns that compute methods of comparing setups
Call CreateSortColumns

SubExit:   ' Catch rates & sort rank already calculated in a called sub (eg trap reset or charmmods)

If Not Range("TrBsTable[#Headers]").End(xlToRight).Value = "Per Cheese" Then Call CreateSortColumns
Range("TrBsTable[[Per Hunt]:[Per Cheese]]").NumberFormat = "#0.000"


' Format the mouse names area
With Sheets("BestSetup").Range(Cells(5, 11), Cells(5, Cells(22, 10).End(xlToRight).Column - 2))
    .WrapText = True
    .Font.ThemeColor = xlThemeColorLight2
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
    .Interior.ThemeColor = xlThemeColorAccent6
    .Interior.TintAndShade = 0.55
End With
With Sheets("BestSetup").Range(Cells(7, 11), Cells(7, Cells(22, 10).End(xlToRight).Column - 2))
    .NumberFormat = "#,##0"
    .Interior.ThemeColor = xlThemeColorLight2
    .Interior.TintAndShade = 0.8
End With
With Sheets("BestSetup").Range(Cells(5, 11), Cells(7, Cells(22, 10).End(xlToRight).Column - 2))
    .Borders.ThemeColor = 1
End With
Sheets("BestSetup").Columns("K:AA").ColumnWidth = 10

' Restore Autofilters
If filterflag Then Call SetAutofilterNames(AutoFCriteria())

' Restore M_cheese worksheet state
Sheets("M_cheese").ListObjects("M_attraction").Range.AutoFilter field:=CheeseCol
If Range("EventIndex").Value = 2 Then _
        Sheets("M_cheese").ListObjects("M_attraction").Range.AutoFilter field:=2


'Write the cheese used
Range("PrevCheese").Value = Range("CheeseIndex").Value
Application.Calculate
If Not usrSortKey Like "Per*" Then usrSortKey = vbNullString
Call SortLocation(usrSortKey)
Debug.Print "AssignMPetc: " & Format(Timer - stTime, "##0.0000") & " seconds total"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub CharmMods()
' Charms can do funky things -- so let's account for it.
' Written by Ben Hauch on 3/31/11
' Last updated 02/02/12 by Ben Hauch

Dim CharmName$, Full%
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If Not Range("PrevCharm").Value = vbNullString Then Full = 1 Else Full = 0
Select Case Application.Index(Range("Locations29"), Sheets("BestSetup").Range("LocationIndex"))
Case "Chocolate Factory 2011", "Chocolate Factory 2012"
    If Application.IsEven(Range("CheeseIndex")) Then 'Force use of Dark Chocolate Charms
        Range("CharmIndex").Value = Application.Match("Dark Chocolate", Range("Charmnames"), 0)
        If Range("PrevCharm").Value = "DChoco" Then ' already have DChoco stats calculated
            If Range("PrevCheese").Value = Range("Cheeseindex").Value Then
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        Else
            CharmName = "Dark Chocolate"
            Range("PrevCharm").Value = "DChoco"
        End If
    Else
        CharmName = Application.Index(Range("Charmnames"), Range("Charmindex").Value)
        If CharmName = "Dark Chocolate" Then
            Range("CheeseIndex").Value = Range("CheeseIndex").Value + 1
            Call AssignMousesNamePowerType
            End If
    End If
Case "Muridae Market"
    If Application.IsEven(Range("CheeseIndex")) Then 'Force use of Artisan Charms
        Range("CharmIndex").Value = Application.Match("Artisan", Range("Charmnames"), 0)
        If Range("PrevCharm").Value = "Artisan" Then ' already have Artisan stats calculated
            If Range("PrevCheese").Value = Range("Cheeseindex").Value Then
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        Else
            CharmName = "Artisan"
            Range("PrevCharm").Value = "Artisan"
        End If
    Else
        CharmName = Application.Index(Range("Charmnames"), Range("Charmindex").Value)
        If CharmName = "Artisan" Then
            Range("CheeseIndex").Value = Range("CheeseIndex").Value + 1
            Call AssignMousesNamePowerType
            End If
    End If
Case "Slushy Shoreline"
    If Application.IsEven(Range("CheeseIndex")) Then 'Force use of Soft Serve Charms
        Range("CharmIndex").Value = Application.Match("Soft Serve", Range("Charmnames"), 0)
        If Range("PrevCharm").Value = "SoftServe" Then ' already have Soft Serve stats calculated
            If Range("PrevCheese").Value = Range("Cheeseindex").Value Then
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        Else
            CharmName = "Soft Serve"
            Range("PrevCharm").Value = "SoftServe"
        End If
    Else
        CharmName = Application.Index(Range("Charmnames"), Range("Charmindex").Value)
        If CharmName = "Soft Serve" Then
            Range("CheeseIndex").Value = Range("CheeseIndex").Value + 1
            Call AssignMousesNamePowerType
            End If
    End If
Case "Crystal Library"
    If Application.IsEven(Range("CheeseIndex")) Then 'Force use of Scholar Charms
        Range("CharmIndex").Value = Application.Match("Scholar", Range("Charmnames"), 0)
        If Range("PrevCharm").Value = "CScholar" Then ' already have Scholar stats calculated
            If Range("PrevCheese").Value = Range("Cheeseindex").Value Then
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        Else
            CharmName = "Scholar"
            Range("PrevCharm").Value = "CScholar"
        End If
    Else
        CharmName = Application.Index(Range("Charmnames"), Range("Charmindex").Value)
        If CharmName = "Scholar" Then
            Range("CheeseIndex").Value = Range("CheeseIndex").Value + 1
            Call AssignMousesNamePowerType
            End If
    End If
Case "Terrortories - Corn Maze", "Terrortories - Haunted Manor", "Terrortories - Pumpkin Patch"
    If (((Range("CheeseIndex").Value - 1) \ 4) > 0) Then    ' Force Spooky Charm
        Range("CharmIndex").Value = Application.Match("Spooky", Range("CharmNames"), 0)
        If Range("PrevCharm").Value = "Spooky" Then ' Stats are up-to-date
            If Range("PrevCheese").Value = Range("CheeseIndex").Value Then
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        Else
            CharmName = "Spooky"
            Range("PrevCharm").Value = "Spooky"
        End If
    Else
        CharmName = Application.Index(Range("Charmnames"), Range("CharmIndex").Value)
        If CharmName = "Spooky" Then
            Range("CheeseIndex").Value = Range("CheeseIndex").Value + 4
            Call AssignMousesNamePowerType
        End If
    End If
Case "Festive Comet 2011"
    If (Range("Cheeseindex").Value = 4) Then
        ' Need Winter Charms
        Range("CharmIndex").Value = Application.Match("Winter", Range("CharmNames"), 0)
        If Range("PrevCharm").Value = "Winter" Then
            If Range("PrevCheese").Value = Range("CheeseIndex").Value Then
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        Else
            CharmName = "Winter"
            Range("PrevCharm").Value = "Winter"
        End If
    Else
        CharmName = Application.Index(Range("CharmNames"), Range("CharmIndex").Value)
        If CharmName = "Winter" Then
            Range("CheeseIndex").Value = 4
            Call AssignMousesNamePowerType
        End If
    End If
Case "Snow Fortress - Gateway", "Snow Fortress - Courtyard", "Snow Fortress - Keep"
    If (Range("Cheeseindex").Value = 2) Then
        ' Need Winter Charms
        Range("CharmIndex").Value = Application.Match("Winter", Range("CharmNames"), 0)
        If Range("PrevCharm").Value = "Winter" Then
            If Range("PrevCheese").Value = Range("CheeseIndex").Value Then
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        Else
            CharmName = "Winter"
            Range("PrevCharm").Value = "Winter"
        End If
    Else
        CharmName = Application.Index(Range("CharmNames"), Range("CharmIndex").Value)
        If CharmName = "Winter" Then
            Range("CheeseIndex").Value = 2
            Call AssignMousesNamePowerType
        End If
    End If
Case "Year of the Dragon Festival"
    Select Case ((Range("Cheeseindex").Value - 1) Mod 4) ' 0 = regular charm, 1 = FC, 2 = Poop, 3 = Breath
    Case 0
        ' Enforce appropriate (dis)arming of Firecracker/Nitropop/Dragon Breath charms
        CharmName = Application.Index(Range("CharmNames"), Range("CharmIndex").Value)
        Select Case CharmName
        Case "Firecracker"
            Range("CheeseIndex").Value = Range("CheeseIndex").Value + 1
            Call AssignMousesNamePowerType
        Case "Nitropop"
            Range("CheeseIndex").Value = Range("CheeseIndex").Value + 2
            Call AssignMousesNamePowerType
        Case "Dragon Breath"
            Range("CheeseIndex").Value = Range("CheeseIndex").Value + 3
            Call AssignMousesNamePowerType
        End Select
    Case 1
        ' Enforce arming of Firecracker charms
        Range("CharmIndex").Value = Application.Match("Firecracker", Range("CharmNames"), 0)
        If Range("PrevCharm").Value = "Fcracker" Then
            If Range("PrevCheese").Value = Range("CheeseIndex").Value Then
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        Else
            CharmName = "Firecracker"
            Range("PrevCharm").Value = "Fcracker"
        End If
    Case 2
        ' Enforce arming of Nitropop charms
        Range("CharmIndex").Value = Application.Match("Nitropop", Range("CharmNames"), 0)
        If Range("PrevCharm").Value = "Npoop" Then
            If Range("PrevCheese").Value = Range("CheeseIndex").Value Then
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        Else
            CharmName = "Nitropop"
            Range("PrevCharm").Value = "Npoop"
        End If
    Case 3
        ' Enforce arming of Dragon Breath charms
        Range("CharmIndex").Value = Application.Match("Dragon Breath", Range("CharmNames"), 0)
        If Range("PrevCharm").Value = "DBreath" Then
            If Range("PrevCheese").Value = Range("CheeseIndex").Value Then
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        Else
            CharmName = "Dragon Breath"
            Range("PrevCharm").Value = "DBreath"
        End If
    End Select
Case Else
    CharmName = Application.Index(Range("Charmnames"), Range("Charmindex").Value)
End Select

' Has anything even really changed?  Will only apply for CR boosting stats
If Range("OldCharm").Value = Range("CharmIndex").Value Then
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Exit Sub
    End If

Select Case CharmName
' Attraction-only charms
Case "Attraction", "Valentine"
    If CharmName = "Valentine" Then
        Range("PrevCharm").Value = "Nanny"  'This will trigger a cheese effect calculation
    Else                                    ' which is why here it is set before the reset call
        Range("PrevCharm").Value = "Attraction"
        End If
    If Full = 1 Then Call TrapReset("All") Else Call TrapReset("Attraction")

' Power-only charms
Case "Power", "Empowered Anchor", "First Ever", "Prospector", "Scientist", "Super Rotten", _
     "Ultimate Power", "Rotten", "Dark Chocolate", "Super Power", "Tribal Power", "Spellbook", _
     "Spooky", "Firecracker", "Nitropop", "Dragon Breath", "Mining"
    If (CharmName Like "*otten") Then
        Range("PrevCharm").Value = "Nanny"  'This will trigger a cheese effect calculation
    ElseIf (CharmName = "Dark Chocolate") Then
        Range("PrevCharm").Value = "DChoco" ' which is why here it is set before the reset call
    ElseIf (CharmName = "Spellbook") Then
        Range("PrevCharm").Value = "SBB"
    ElseIf (CharmName = "Spooky") Then
        Range("PrevCharm").Value = "Spooky"
    ElseIf (CharmName = "Firecracker") Then
        Range("PrevCharm").Value = "Fcracker"
    ElseIf (CharmName = "Nitropop") Then
        Range("PrevCharm").Value = "Npoop"
    ElseIf (CharmName = "Dragon Breath") Then
        Range("PrevCharm").Value = "DBreath"
    Else
        Range("PrevCharm").Value = "Power"
    End If
    If Full = 1 Then Call TrapReset("All") Else Call TrapReset("Power")

' Luck-only charms
Case "Luck", "Lucky Rabbit", "Ultimate Luck", "Super Luck", "Winter", "Winter Toy"
    If (CharmName = "Winter") Then
        Range("PrevCharm").Value = "Winter"
    Else
        Range("PrevCharm").Value = "Luck"
    End If
    If Full = 1 Then Call TrapReset("All") Else Call TrapReset("Luck")

' Multi-mode charms
Case "Artisan", "Lucky Power", "Nanny", "Freshness", "Cackle", "Champion", "Chrome", "Tarnished", "Party"
    If CharmName = "Nanny" Then Range("TrBsTable[Trap type]").Value = "Parental"
    Call TrapReset("All")
    If CharmName = "Artisan" Then
        Range("PrevCharm").Value = "Artisan"
    Else
        Range("PrevCharm").Value = "Nanny"
    End If

' Cheese effect only charms
' need to develop, includes Freshness and Tarnished

' Charms that have a hidden catch rate bonus but no normal universal stat bonus
' Note that the hidden catch rate bonus will need to be coded in CatchRateColumns for this to do anything
Case "Super Warpath Archer", "Super Warpath Cavalry", "Super Warpath Mage", "Flamebane", _
     "Super Warpath Scout", "Super Warpath Warrior", "Super Warpath Commander", "Dragonbane", _
     "Rook Crumble", "Scholar", "Dreaded"
    If Full = 1 Then Call TrapReset("All") Else Call TrapReset("Luck")
    If CharmName = "Scholar" Then Range("PrevCharm").Value = "CScholar" Else Range("PrevCharm").Value = "Luck"

' Charms that have no effect on anything the sheet can manage
Case "Warpath Archer", "Warpath Cavalry", "Warpath Mage", "Warpath Scout", "Warpath Warrior", _
    "Warpath Commander", "Antiskele", "Monger", "Wealth", "Amplifier", "Uncharged Scholar", "Eggstra", _
    "Soft Serve", "Wax", "Sticky"
    If Full = 1 Then Call TrapReset("All")
    If Not CharmName = "Soft Serve" Then Range("PrevCharm").Value = vbNullString Else Call TrapReset("Attraction")

Case "None"
    Select Case Range("PrevCharm").Value
    Case "Attraction", "SoftServe"
        Call TrapReset("Attraction")
        Range("PrevCharm").Value = vbNullString
    Case "Power", "SBB", "Fcracker", "Npoop", "DBreath"
        Call TrapReset("Power")
        Range("PrevCharm").Value = vbNullString
    Case "Luck", "Winter"
        Call TrapReset("Luck")
        Range("PrevCharm").Value = vbNullString
    Case "Nanny", "DChoco", "Artisan", "CScholar", "Spooky"
        Call TrapReset("All")
        Range("PrevCharm").Value = vbNullString
    End Select
End Select
Range("OldCharm").Value = Range("CharmIndex").Value
If Sheets("BestSetup").ListObjects("TrBsTable").Sort.SortFields.Count > 0 Then usrSortKey = Sheets("Bestsetup").Cells(22, Sheets("bestSetup").ListObjects("Trbstable").Sort.SortFields.Item(1).Key.Column).Value
If Not usrSortKey Like "Per*" Then usrSortKey = vbNullString
Call SortLocation(usrSortKey)
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Sub btnClear1_Click()
  If ActiveSheet.Name = "CRE" Then Sheets("CRE").Range("CRESetup1") = ""
End Sub

Private Sub btnClear2_Click()
  If ActiveSheet.Name = "CRE" Then Sheets("CRE").Range("CRESetup2") = ""
End Sub

Private Sub btnClear3_Click()
  If ActiveSheet.Name = "CRE" Then Sheets("CRE").Range("CRESetup3") = ""
End Sub

Private Sub btnClear4_Click()
  If ActiveSheet.Name = "CRE" Then Sheets("CRE").Range("CRESetup4") = ""
End Sub

Private Sub btnClear5_Click()
  If ActiveSheet.Name = "CRE" Then Sheets("CRE").Range("CRESetup5") = ""
End Sub

Private Sub btnClear6_Click()
  If ActiveSheet.Name = "CRE" Then Sheets("CRE").Range("CRESetup6") = ""
End Sub
Private Sub btnPaste1_Click()
    Dim i As Integer: Application.ScreenUpdating = False
    If ActiveSheet.Name = "CRE" Then
        For i = 2 To 6
            Sheets("CRE").Range("CRESetup" & "" & i & "").Value = Sheets("CRE").Range("CRESetup1").Value
        Next i
    End If
    Application.ScreenUpdating = True
End Sub
' btnPaste Subs added by Frank Halena on 02/03/12
Private Sub btnPaste2_Click()
  If ActiveSheet.Name = "CRE" Then Sheets("CRE").Range("CRESetup2").Value = Sheets("CRE").Range("CRESetup1").Value
End Sub

Private Sub btnPaste3_Click()
  If ActiveSheet.Name = "CRE" Then Sheets("CRE").Range("CRESetup3").Value = Sheets("CRE").Range("CRESetup2").Value
End Sub

Private Sub btnPaste4_Click()
  If ActiveSheet.Name = "CRE" Then Sheets("CRE").Range("CRESetup4").Value = Sheets("CRE").Range("CRESetup3").Value
End Sub

Private Sub btnPaste5_Click()
  If ActiveSheet.Name = "CRE" Then Sheets("CRE").Range("CRESetup5").Value = Sheets("CRE").Range("CRESetup4").Value
End Sub

Private Sub btnPaste6_Click()
  If ActiveSheet.Name = "CRE" Then Sheets("CRE").Range("CRESetup6").Value = Sheets("CRE").Range("CRESetup5").Value
End Sub
'
'
'END MAINLINE MACROS
'BEGIN "UTILITY" MACROS
'

Public Function CATCHRATE(ByVal Eff#, ByVal Power#, ByVal Luck#, ByVal MousePower#)
' Written by Ben Hauch
' Last updated by Ben Hauch on 2/12/11

    ' By using a function we can clean up the user-end of the spreadsheet
    ' A function also makes it easy to change the model if necessary
    ' Use of the function requires macro support
    ' Prior formulas are:
        ' For BestSetup page
'=IF([@Effective]=0,0,MIN(0.9999,(([@Effective]*[@Power])+(3-MIN(2,[@Effective]))*(MIN(2,[@Effective])*[@Luck])^2)/(([@Effective]*[@Power])+$E$4)))

        ' For CRE page
'=IF(OR(ISBLANK(C$2),ISBLANK(C$3),ISBLANK(C$7)),"",IF(C$15=0,0,MIN(0.9999,((C$15*C$9)+(3-MIN(2,C$15))*(MIN(2,C$15)*C$11)^2)/((C$15*C$9)+$B23))))
    If Eff < 2 Then
        CATCHRATE = (Eff * Power + (3 - Eff) * (Eff * Luck) ^ 2) / _
                            (Eff * Power + MousePower)
    Else
        CATCHRATE = (Eff * Power + (2 * Luck) ^ 2) / _
                       (Eff * Power + MousePower)
    End If
    If CATCHRATE >= 1 Then CATCHRATE = 0.9999
End Function
Private Sub SortLocation(Optional sSortKeyL, Optional iUpDownL)
' Based on SortCatch as written by Ben Hauch, 2/16/11
' Significantly repurposed by Ryan J Smith on 3/28/11
' Last updated 3/25/11 by Ben Hauch

If IsMissing(sSortKeyL) Or sSortKeyL = vbNullString Then sSortKeyL = "Per Hunt"
If IsMissing(iUpDownL) Then iUpDownL = 2

'Ensure that the weighting formula is present & current
If Range("TrBsTable[Luck]").Count > Range("TrBsTable[Per Hunt]").Count Then Call CreateSortColumns

Sheets("BestSetup").ListObjects("TrBsTable").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("BestSetup").ListObjects("TrBsTable").Sort.SortFields.Add _
        Key:=Range("TrBsTable[[#All],[" & sSortKeyL & "]]"), SortOn:=xlSortOnValues, _
        Order:=iUpDownL, DataOption:=xlSortTextAsNumbers

With Sheets("BestSetup").ListObjects("TrBsTable").Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .Apply
End With
End Sub
Private Sub TikiBoost()
' Written by Ben Hauch on 3/31/11
' Last updated 5/5/11 by Ben Hauch
' Adds the location-specific boost to Tiki Base combinations only (+6 LCK)

Dim i%, rCell As Range, CharmName$, TrapL%, BaseL%, CharmL%, TikiCells As Range, stTime
stTime = Timer
Let i = 0
CharmName = Application.Index(Range("Charmnames"), Range("Charmindex").Value)
CharmL = Sheets("Charms").Range("Charms[Charm]").Find(CharmName, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 4).Value
Set TikiCells = Find_Range("Tiki", Sheets("BestSetup").Range("TrBsTable[Base]").SpecialCells(xlCellTypeVisible))
If Range("ShieldIndex").Value = 1 Then CharmL = CharmL + 7
On Error Resume Next
For Each rCell In TikiCells
    ' Add 6 Luck to the Luck Column -- make sure to alter offset when changing TrBsTable dimensions
    rCell.Offset(0, 7).Value = Range("Traps").Find(rCell.Offset(0, -1).Value, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 6).Value + 6 + CharmL
Next rCell
On Error GoTo 0
Debug.Print "TikiBoost: " & Format(Timer - stTime, "##0.000") & " seconds"
End Sub
Private Sub SoulXLuckBoost(Location As String)
' Written by Ben Hauch on 10/21/11
' Last updated by Ben Hauch on 10/21/11
' Adds the Luck Boost for the Soul Catcher and Soul Harvester LE traps
'  when in Terrortories or SG - Fall (Harvester only)
Dim i As Long, rCell As Range, Boostcells As Range, WeaponLuck, stTime, _
    CharmName As String, CharmL As Integer
stTime = Timer
Let i = 0
CharmName = Application.Index(Range("Charmnames"), Range("Charmindex").Value)
CharmL = Sheets("Charms").Range("Charms[Charm]").Find(CharmName, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 4).Value
If Range("ShieldIndex").Value = 1 Then CharmL = CharmL + 7
If Range("BonusWeekend").Value = 1 Then CharmL = CharmL + 5
If Location = "Terror" Then
'  Apply bonus to both
    Set Boostcells = Find_Range("Soul ", Sheets("BestSetup").Range("TrBsTable[Trap]").SpecialCells(xlCellTypeVisible), LookIn:=xlValues, LookAt:=xlPart)
    On Error Resume Next
    For Each rCell In Boostcells
        ' Add 10 luck to the luck value
        rCell.Offset(0, 8).Value = Range("Bases").Find(rCell.Offset(0, 1).Value, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 5).Value + 10 + CharmL + _
                                   Range("Traps").Find(rCell.Value, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 6).Value
    Next rCell
    On Error GoTo 0
Else
'  Apply bonus only to Soul Harvester
    Set Boostcells = Find_Range("Soul Harvester", Sheets("BestSetup").Range("TrBsTable[Trap]").SpecialCells(xlCellTypeVisible))
    On Error Resume Next
    For Each rCell In Boostcells
        ' add 10? luck to the luck value
        rCell.Offset(0, 8).Value = Range("Bases").Find(rCell.Offset(0, 1).Value, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 5).Value + 10 + CharmL + 12
    Next rCell
    On Error GoTo 0
End If
Debug.Print "Soulboost: " & Format(Timer - stTime, "###0.000") & " seconds"
End Sub
Private Sub SeasonalBoost()
' Written by Ben Hauch on 3/31/11
' Last updated 5/5/11 by Ben Hauch
' Adds the location-specific boost to Seasonal Base combinations only (+18% PB)
Dim i%, rCell As Range, SeasonalCells As Range, WeaponPower#, WeaponBonus#, CharmPower#, CharmBonus#, CharmName$, stTime
stTime = Timer
Let i = 0
CharmName = Application.Index(Range("Charmnames"), Range("Charmindex").Value)
If CharmName = "Tribal Power" Then
    CharmPower = 0
    CharmBonus = 0
Else
    CharmPower = Range("Charms").Find(CharmName, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 1).Value
    CharmBonus = Range("Charms").Find(CharmName, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 2).Value
End If
Set SeasonalCells = Find_Range("Seasonal", Sheets("BestSetup").Range("TrBsTable[Base]").SpecialCells(xlCellTypeVisible))
On Error Resume Next
For Each rCell In SeasonalCells
    WeaponPower = Range("Traps").Find(rCell.Offset(0, -1).Value, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 3).Value + 300 + CharmPower
    WeaponBonus = Range("Traps").Find(rCell.Offset(0, -1).Value, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 4).Value + 0.18 + CharmBonus
    rCell.Offset(0, 3).Value = WeaponPower
    rCell.Offset(0, 4).Value = WeaponBonus
    rCell.Offset(0, 5).Value = WeaponPower * (1 + WeaponBonus)
Next rCell
On Error GoTo 0
Debug.Print "SeasonalBoost: " & Format(Timer - stTime, "##0.000") & " seconds"
End Sub
Private Sub SBBCharm()
' Written by Ben Hauch on 8/12/11
' Last updated by Ben Hauch on 8/12/11
' Adds the base-specific boost when using the Spellbook Charm (+500 power, +8% bonus)
Dim i%, rCell As Range, SBBCells As Range, WeaponPower#, WeaponBonus#
Let i = 0
Set SBBCells = Find_Range("Spellbook", Sheets("BestSetup").Range("TrBsTable[Base]").SpecialCells(xlCellTypeVisible))
On Error Resume Next
For Each rCell In SBBCells
    WeaponPower = Range("Traps").Find(rCell.Offset(0, -1).Value, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 3).Value + 500 + 500
    WeaponBonus = Range("Traps").Find(rCell.Offset(0, -1).Value, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 4).Value + 0.14 + 0.08
    rCell.Offset(0, 3).Value = WeaponPower
    rCell.Offset(0, 4).Value = WeaponBonus
    rCell.Offset(0, 5).Value = WeaponPower * (1 + WeaponBonus)
Next rCell
On Error GoTo 0
Debug.Print "SBBBoosted"
End Sub
Private Sub TrapReset(Attrib$)
' Written by Ben Hauch on 3/31/11
' Last updated 10/21/11 by Ben Hauch
' Recalculates the specified trap attributes in accordance with generic charms or special base usage
Dim stTime#
stTime = Timer
Dim Shield%, CharmName$, CharmPower#, CharmBonus#, CharmA#, CharmL%, CharmCFX%, filterflag As Boolean, AutoFCriteria() As Variant
Dim PasteRange As Range, t() As Variant, CRE() As Variant, j As Long, tmp1() As Variant, tmp2() As Variant
Dim BaseRow%, TrapRow%, rMice() As Variant, allMice() As Variant, Location$

'Store any Autofilters (e.g. trap&base combinations) and then remove them
Sheets("BestSetup").Range("B22").Select
If Sheets("BestSetup").FilterMode Then
    filterflag = True
    AutoFCriteria = GetAutofilterNames
    Sheets("BestSetup").AutoFilterMode = False
    Sheets("BestSetup").Range("TrBsTable").AutoFilter
    End If
Let j = 1
Shield = Range("ShieldIndex").Value
CharmName = Application.Index(Range("Charmnames"), Range("Charmindex").Value)
Location = Range("LocationName").Value
Set PasteRange = Nothing

ReDim CRE(1 To Range("TrBsTable[Trap]").Count, 1 To Range("TrBsTable[Luck]").Column - 1) '-1 because we start in column B, not A
ReDim tmp1(1 To Range("Traps[Weapon]").Count, 1 To 8), _
      tmp2(1 To Range("Bases[Base]").Count, 1 To 7)

' Copy the current BestSetup table into a VBA array
CRE = Range("TrBsTable[[Trap]:[Luck]]").Value

' Reset only the values that need resetting
Select Case Range("PrevCharm").Value
Case "Nanny", "DChoco", "Artisan", "Champion"
    Attrib = "All" 'Trigger Cheese Effect recalculation
End Select
Select Case Attrib
    Case "Power"
        Set PasteRange = Range("TrBsTable[[Sum Power]:[Power]]")
        CharmPower = Range("Charms").Find(CharmName, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 1).Value
        CharmBonus = Range("Charms").Find(CharmName, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 2).Value

        'Tribal Area only location effect  - however, is not called if the setup doesn't change but location does
        If (CharmName = "Tribal Power") Then
            If Not ((Location = "Nerg Plains") Or (Location = "Derr Dunes") Or (Location = "Elub Shore")) Then
                CharmPower = 0
                CharmBonus = 0
            End If
        End If

        ' First - Redimension the arrays to the current size of the CRE table
        ReDim t(1 To UBound(CRE), 1 To 4)
        ' Next - Redim tmp1() to the trap table only, and tmp2 to the base table only
        tmp1 = Range("Traps[[Weapon]:[Cheese Effect]]").Value
        tmp2 = Range("Bases[[Base]:[Cheese Effect]]").Value
        For j = 1 To UBound(CRE)
            TrapRow = Application.Match(CRE(j, 1), Application.Index(tmp1, 0, 1), 0)
            BaseRow = Application.Match(CRE(j, 2), Application.Index(tmp2, 0, 1), 0)
            t(j, 1) = tmp1(TrapRow, 4)
            t(j, 2) = tmp1(TrapRow, 5)
            t(j, 3) = tmp2(BaseRow, 3)
            t(j, 4) = tmp2(BaseRow, 4)
        Next j
        ' Now we're done with tmp1 and tmp2, so we can run the total power computation in a redimensioned array
        ReDim tmp1(1 To UBound(CRE), 1 To 3), tmp2(0)
        For j = 1 To UBound(tmp1)
            tmp1(j, 1) = t(j, 1) + t(j, 3) + CharmPower
            tmp1(j, 2) = t(j, 2) + t(j, 4) + CharmBonus
            tmp1(j, 3) = Application.RoundUp(tmp1(j, 1) * (1 + tmp1(j, 2)), 0)
        Next j
        ' now we just need to paste this Nx3 array back to the CRE table
        PasteRange.Value = tmp1
        ' erase arrays from memory
        Set PasteRange = Nothing
        ReDim CRE(0), tmp1(0)
    Case "Attraction"
        CharmA = Range("Charms").Find(CharmName, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 3).Value
        Set PasteRange = Range("TrBsTable[ATR]")
        ReDim t(1 To UBound(CRE), 5 To 6)
        tmp1 = Range("Traps[[Weapon]:[Cheese Effect]]").Value
        tmp2 = Range("Bases[[Base]:[Cheese Effect]]").Value
        For j = 1 To UBound(CRE)
            t(j, 5) = Application.VLookup(CRE(j, 1), tmp1, 6, False)
            t(j, 6) = Application.VLookup(CRE(j, 2), tmp2, 5, False)
        Next j
        ReDim tmp1(1 To UBound(CRE), 1 To 1), tmp2(0)
        For j = 1 To UBound(tmp1)
            tmp1(j, 1) = (t(j, 5) + t(j, 6) + CharmA)
        Next j
        PasteRange.Value = tmp1
        Set PasteRange = Nothing
        ReDim CRE(0), tmp1(0)
    Case "Luck"
        CharmL = Range("Charms").Find(CharmName, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 4).Value
        Set PasteRange = Range("TrBsTable[Luck]")
        ReDim t(1 To UBound(CRE), 7 To 8)
        tmp1 = Range("Traps[[Weapon]:[Cheese Effect]]").Value
        tmp2 = Range("Bases[[Base]:[Cheese Effect]]").Value
        For j = 1 To UBound(CRE)
            t(j, 7) = Application.VLookup(CRE(j, 1), tmp1, 7, False)
            t(j, 8) = Application.VLookup(CRE(j, 2), tmp2, 6, False)
        Next j
        If Shield = 1 Then CharmL = CharmL + 7
        If Range("BonusWeekend").Value = 1 Then CharmL = CharmL + 5
        ReDim tmp1(1 To UBound(CRE), 1 To 1), tmp2(0)
        For j = 1 To UBound(tmp1)
            tmp1(j, 1) = (t(j, 7) + t(j, 8) + CharmL)
        Next j
        PasteRange.Value = tmp1
        Set PasteRange = Nothing
        ReDim CRE(0), tmp1(0)
    Case "All"
        CharmL = Range("Charms").Find(CharmName, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 4).Value
        CharmA = Range("Charms").Find(CharmName, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 3).Value
        CharmPower = Range("Charms").Find(CharmName, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 1).Value
        CharmBonus = Range("Charms").Find(CharmName, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 2).Value
        CharmCFX = Range("Charms").Find(CharmName, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 5).Value
        If Shield = 1 Then CharmL = CharmL + 7
        If Range("BonusWeekend").Value = 1 Then CharmL = CharmL + 5
        'Tribal Area only location effect  - however, is not called if the setup doesn't change but location does
        If (CharmName = "Tribal Power") Then
            If Not ((Location = "Nerg Plains") Or (Location = "Derr Dunes") Or (Location = "Elub Shore")) Then
                CharmPower = 0
                CharmBonus = 0
            End If
        End If
        Set PasteRange = Range("TrBsTable[[Trap]:[Luck]]")
        tmp1 = Range("Traps[[Weapon]:[Cheese Effect]]").Value
        tmp2 = Range("Bases[[Base]:[Cheese Effect]]").Value
        ReDim t(1 To UBound(CRE), 1 To 10)
        If CharmName = "Champion" Then
            For j = 1 To UBound(CRE)
                TrapRow = Application.Match(CRE(j, 1), Application.Index(tmp1, 0, 1), 0)
                BaseRow = Application.Match(CRE(j, 2), Application.Index(tmp2, 0, 1), 0)
                t(j, 1) = tmp1(TrapRow, 4)  ' Trap Power
                t(j, 2) = tmp1(TrapRow, 5)  ' Trap Bonus
                t(j, 3) = tmp2(BaseRow, 3)  ' Base Power
                t(j, 4) = tmp2(BaseRow, 4)  ' Base Bonus
                t(j, 5) = tmp1(TrapRow, 6)  ' Trap Attraction Bonus
                t(j, 6) = tmp2(BaseRow, 5)  ' Base Attraction Bonus
                t(j, 7) = tmp1(TrapRow, 7)  ' Trap Luck
                If CRE(j, 2) Like "Bronze To*" Then
                    t(j, 8) = 7                 ' 5 base + 2 with Champ charm
                ElseIf CRE(j, 2) Like "Silver To*" Then
                    t(j, 8) = 10                ' 7 base + 3 with Champ charm
                ElseIf CRE(j, 2) Like "Golden To*" Then
                    t(j, 8) = 12                ' 8 base + 4 with Champ charm
                Else
                    t(j, 8) = tmp2(BaseRow, 6)  ' For non-Tourney bases
                End If
                t(j, 9) = tmp1(TrapRow, 3)  ' Trap Type
                t(j, 10) = Application.Min(6, Application.Max(-6, tmp1(TrapRow, 8) + tmp2(BaseRow, 7) + CharmCFX))
            Next j
        Else
            For j = 1 To UBound(CRE)
                TrapRow = Application.Match(CRE(j, 1), Application.Index(tmp1, 0, 1), 0)
                BaseRow = Application.Match(CRE(j, 2), Application.Index(tmp2, 0, 1), 0)
                t(j, 1) = tmp1(TrapRow, 4)  ' Trap Power
                t(j, 2) = tmp1(TrapRow, 5)  ' Trap Bonus
                t(j, 3) = tmp2(BaseRow, 3)  ' Base Power
                t(j, 4) = tmp2(BaseRow, 4)  ' Base Bonus
                t(j, 5) = tmp1(TrapRow, 6)  ' Trap Attraction Bonus
                t(j, 6) = tmp2(BaseRow, 5)  ' Base Attraction Bonus
                t(j, 7) = tmp1(TrapRow, 7)  ' Trap Luck
                t(j, 8) = tmp2(BaseRow, 6)  ' Base Luck
                t(j, 9) = tmp1(TrapRow, 3)  ' Trap Type
                t(j, 10) = Application.Min(6, Application.Max(-6, tmp1(TrapRow, 8) + tmp2(BaseRow, 7) + CharmCFX))
            Next j
        End If
        ReDim tmp1(1 To UBound(CRE), 1 To 1), tmp2(1 To 13, 1 To 2)
        tmp2 = Range("CheeseEffect").Value
        For j = 1 To UBound(tmp1)
            CRE(j, 3) = t(j, 9)
            CRE(j, 4) = tmp2(t(j, 10) + 7, 1)
            CRE(j, 5) = t(j, 1) + t(j, 3) + CharmPower
            CRE(j, 6) = t(j, 2) + t(j, 4) + CharmBonus
            CRE(j, 7) = Application.RoundUp(CRE(j, 5) * (1 + CRE(j, 6)), 0)
            CRE(j, 8) = (t(j, 5) + t(j, 6) + CharmA)
            CRE(j, 9) = (t(j, 7) + t(j, 8) + CharmL)
        Next j
        PasteRange.Value = CRE
        Set PasteRange = Nothing
        ReDim CRE(0)
End Select

Select Case Application.Index(Range("Locations29[Locations]"), Range("LocationIndex"))
    Case "Seasonal Garden - Spring", "Seasonal Garden - Summer", "Seasonal Garden - Winter"
        Call SeasonalBoost
        Range("PrevLoc").Value = "Seas"
    Case "Seasonal Garden - Fall"
        Call SeasonalBoost
        Call SoulXLuckBoost("SG")
        Range("PrevLoc").Value = "Seasf"
    Case "Derr Dunes", "Nerg Plains", "Elub Shore", "Cape Clawed"
        Call TikiBoost
        Range("PrevLoc").Value = "Trib"
    Case "Terrortories - Corn Maze", "Terrortories - Haunted Manor", "Terrortories - Pumpkin Patch"
        Call SoulXLuckBoost("Terror")
        Range("PrevLoc").Value = "Terror"
    Case Else
        If Range("PrevLoc").Value = "Seas" Then
            Range("PrevLoc").Value = ""
            Call TrapReset("Power")
            End If
        If Range("PrevLoc").Value = "Trib" Then
            Range("PrevLoc").Value = ""
            Call TrapReset("Luck")
            End If
        If Range("PrevLoc").Value = "Seasf" Or Range("Prevloc").Value = "Terror" Then
            Range("PrevLoc").Value = ""
            Call TrapReset("All")
            End If
End Select
If Range("CharmName").Value = "Nanny" Then Range("TrBsTable[Trap type]").Value = "Parental"
If Range("CharmName").Value = "Spellbook" Then Call SBBCharm
rMice = Sheets("BestSetup").Range(Cells(5, 11), Cells(7, Cells(7, 10).End(xlToRight).Column)).Value
If UBound(rMice, 2) > 60 Then GoTo SubExit
allMice = Range("Mice[[#All],[Mice]:[Tactical]]").Value
Call CatchRateColumns(rMice, allMice, Application.Index(Range("Locations29[Locations]"), Range("LocationIndex")))
Call CreateSortColumns

SubExit:
' Restore Autofilters
If filterflag Then Call SetAutofilterNames(AutoFCriteria())
Debug.Print "TrapReset(" & Attrib & "): " & Format(Timer - stTime, "##0.000") & " seconds"
End Sub

Private Sub CatchRateColumns(rMice() As Variant, allMice() As Variant, Location$)
' Written by Ben Hauch over a freaking long period of time ;)
' Last updated by Ben Hauch on 10/21/11

' Call this sub after making a change to Power|Luck|Trap Type|Location|Cheese
' rMice is the array containing the mouse name, subgroup, power, and attraction rate for which catch rates need to
' be calculated.
' allMice is the array containing all mice, powers, and effectivenesses
' Based on LocationName, a different method will be executed (i.e. Dracano is separate due to Dragon & Dragonbane,
' Warpath is separate due to Super Charms, ZT is separate due to the power/penalty adjustments of pinchers/oat/bsp)
stTime = Timer
' General Purpose items
Dim Trapty() As Variant, Power() As Variant, Luck() As Variant, i As Long, j As Long, k As Long, Ubnd As Long
Dim MouseRow%, TraptyCol() As Variant, CRC() As Variant, CharmName$, TrapNames() As Variant
ReDim CRC(1 To Range("TrBsTable[Power]").Count, 1 To UBound(rMice, 2))

Ubnd = UBound(CRC, 1)
Power = Sheets("BestSetup").Range("TrBsTable[[Sum Power]:[Power]]").Value
Luck = Sheets("BestSetup").Range("TrBsTable[Luck]").Value
Trapty = Sheets("BestSetup").Range("TrBsTable[Trap Type]").Value
ReDim TraptyCol(1 To Ubnd)
CharmName = Application.Index(Range("Charmnames"), Range("CharmIndex"))

' Longest operation is determining which columns to grab effectiveness values from.
' To counteract this, we use case statements instead since new types are added very rarely
' and the Mice sheet column order is rather stable
For i = 1 To Ubnd
    Select Case Trapty(i, 1)
    Case "Arcane": TraptyCol(i) = 7
    Case "Draconic": TraptyCol(i) = 8
    Case "Forgotten": TraptyCol(i) = 9
    Case "Hydro": TraptyCol(i) = 10
    Case "Parental": TraptyCol(i) = 11
    Case "Physical": TraptyCol(i) = 12
    Case "Shadow": TraptyCol(i) = 13
    Case "Tactical": TraptyCol(i) = 14
    End Select
Next i

Select Case Location
Case "Dracano"
    If rMice(1, 1) <> "" Then
        ' Do special case (Dragon is always first mouse if sorting didn't fail)
        MouseRow = Application.Match(rMice(1, 1), Application.Index(allMice, 0, 1), 0)
        On Error Resume Next
        For i = 1 To Ubnd
            If Not CharmName = "Dragonbane" Then
                CRC(i, 1) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, 1))
            Else
                CRC(i, 1) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 1) * (4 + Power(i, 2)), Luck(i, 1), rMice(3, 1))
            End If
        Next i
        On Error GoTo 0
        ' Now do the other 2 or more mice
        For j = 2 To UBound(rMice, 2)
            MouseRow = Application.Match(rMice(1, j), Application.Index(allMice, 0, 1), 0)
            For i = 1 To Ubnd
                CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
            Next i
        Next j
    End If
Case "Jungle of Dread"
    ' The Dreaded Charm gives a boost against all members of Dreaded Horde
    If rMice(1, 1) <> "" Then
        For j = 1 To UBound(rMice, 2)
            MouseRow = Application.Match(rMice(1, j), Application.Index(allMice, 0, 1), 0)
            If Not CharmName = "Dreaded" Then
                ' Regular case
                For i = 1 To Ubnd
                    CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                Next i
            Else
                If Not rMice(2, j) = "Dreaded Horde" Then
                    ' Still nothing, you Sylvan you
                    For i = 1 To Ubnd
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                    Next i
                Else
                    ' Boom!
                    For i = 1 To Ubnd
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 1) * (4 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                    Next i
                End If
            End If
        Next j
    End If
Case "Fiery Warpath - Wave 1", "Fiery Warpath - Wave 2", "Fiery Warpath - Wave 3", "Fiery Warpath - Wave 4"
    ' Need to boost all setups that have Super Warpath * as the charm
    If rMice(1, 1) <> "" Then
        For j = 1 To UBound(rMice, 2)
        MouseRow = Application.Match(rMice(1, j), Application.Index(allMice, 0, 1), 0)
        If Not CharmName = "Flamebane" Then
            Select Case rMice(2, j)
            Case "Marching Flame - Archer"
                On Error Resume Next
                For i = 1 To Ubnd
                    If Not CharmName = "Super Warpath Archer" Then
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                    Else
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 1) * (1.5 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                    End If
                Next i
                On Error GoTo 0
            Case "Marching Flame - Warrior"
                On Error Resume Next
                For i = 1 To Ubnd
                    If Not CharmName = "Super Warpath Warrior" Then
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                    Else
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 1) * (1.5 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                    End If
                Next i
                On Error GoTo 0
            Case "Marching Flame - Cavalry"
                On Error Resume Next
                For i = 1 To Ubnd
                    If Not CharmName = "Super Warpath Cavalry" Then
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                    Else
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 1) * (1.5 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                    End If
                Next i
                On Error GoTo 0
            Case "Marching Flame - Mage"
                On Error Resume Next
                For i = 1 To Ubnd
                    If Not CharmName = "Super Warpath Mage" Then
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                    Else
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 1) * (1.5 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                    End If
                Next i
                On Error GoTo 0
            Case "Marching Flame - Scout"
                On Error Resume Next
                For i = 1 To Ubnd
                    If Not CharmName = "Super Warpath Scout" Then
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                    Else
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 1) * (1.5 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                    End If
                Next i
                On Error GoTo 0
            Case "Marching Flame - Commander"
                On Error Resume Next
                For i = 1 To Ubnd
                    If Not CharmName = "Super Warpath Commander" Then
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                    Else
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 1) * (1.5 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                    End If
                Next i
                On Error GoTo 0
            Case Else
                For i = 1 To Ubnd
                    CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                Next i
            End Select
        Else  'Using Flamebane Charm = +150% power bonus
            For i = 1 To Ubnd
                CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 1) * (2.5 + Power(i, 2)), Luck(i, 1), rMice(3, j))
            Next i
        End If
        Next j
    End If
Case "Zugzwang's Tower"
    ' Need to apply side bonuses & penalties
    If rMice(1, 1) <> "" Then
    ' ZT is looped by column then by row, rather than by row then column, due to the insanity
        Dim mouserowarray() As Variant
        ReDim mouserowarray(1 To UBound(rMice, 2))
        For i = 1 To UBound(rMice, 2)
            mouserowarray(i) = Application.Match(rMice(1, i), Application.Index(allMice, 0, 1), 0)
        Next i
        TrapNames = Range("TrBsTable[Trap]").Value
        ' Iterate through mice
        For i = 1 To Ubnd
            Select Case TrapNames(i, 1)
            Case "Mystic Pawn Pincher"
                For j = 1 To UBound(rMice, 2)
                    If Not rMice(1, j) = "Mystic Pawn" Then
                        If Not rMice(1, j) = "Technic Pawn" Then
                            ' Normal attractable mouse
                            If Not CharmName = "Rook Crumble" Then
                                CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), Power(i, 3), Luck(i, 1), rMice(3, j))
                            Else
                                ' Rook Crumble Charm
                                If Not rMice(1, j) Like "*Rook" Then
                                    CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), Power(i, 3), Luck(i, 1), rMice(3, j))
                                Else
                                    CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), Power(i, 1) * (5 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                                End If
                            End If
                        Else ' Technic Pawn -- include penalty to power & bonus
                            CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), TraptyCol(i)), (Power(i, 1) - 60) * (1 + Power(i, 2) - 0.05), Luck(i, 1), rMice(3, j))
                        End If
                    Else ' Mystic Pawn! Yay! pwn it.
                        CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), TraptyCol(i)), (Power(i, 1) + 10920) * (1 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                    End If
                Next j
            Case "Technic Pawn Pincher"
                For j = 1 To UBound(rMice, 2)
                    If Not rMice(1, j) = "Technic Pawn" Then
                        If Not rMice(1, j) = "Mystic Pawn" Then
                            ' Normal attractable mouse
                            If Not CharmName = "Rook Crumble" Then
                                CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), Power(i, 3), Luck(i, 1), rMice(3, j))
                            Else
                                ' Rook Crumble Charm
                                If Not rMice(1, j) Like "*Rook" Then
                                    CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), Power(i, 3), Luck(i, 1), rMice(3, j))
                                Else
                                    CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), Power(i, 1) * (5 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                                End If
                            End If
                        Else ' Mystic Pawn -- include penalty to power & bonus
                            CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), (Power(i, 1) - 60) * (1 + Power(i, 2) - 0.05), Luck(i, 1), rMice(3, j))
                        End If
                    Else ' Technic Pawn! Yay! pwn it.
                        CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), (Power(i, 1) + 10920) * (1 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                    End If
                Next j
            Case "Blackstone Pass"
                For j = 1 To UBound(rMice, 2)
                    If Not rMice(1, j) Like "Mystic*" Then
                        If Not rMice(1, j) Like "Technic*" Then
                            ' Normal attractable mouse
                            CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), Power(i, 3), Luck(i, 1), rMice(3, j))
                        Else ' Technic Side -- include penalty to power & bonus
                            If Not CharmName = "Rook Crumble" Then
                                CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), (Power(i, 1) - 2400) * (1 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                            Else
                                If Not rMice(1, j) Like "*Rook" Then
                                    CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), (Power(i, 1) - 2400) * (1 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                                Else
                                    CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), (Power(i, 1) - 2400) * (5 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                                End If
                            End If
                        End If
                    Else ' Mystic Side! Yay! pwn it.
                        If Not CharmName = "Rook Crumble" Then
                            CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), (Power(i, 1) + 1800) * (1 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                        Else
                            If Not rMice(1, j) Like "*Rook" Then
                                CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), (Power(i, 1) + 1800) * (1 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                            Else
                                CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), (Power(i, 1) + 1800) * (5 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                            End If
                        End If
                    End If
                Next j
            Case "Obvious Ambush"
                For j = 1 To UBound(rMice, 2)
                    If Not rMice(1, j) Like "Technic*" Then
                        If Not rMice(1, j) Like "Mystic*" Then
                            ' Normal attractable mouse
                            CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), Power(i, 3), Luck(i, 1), rMice(3, j))
                        Else ' Mystic Side -- include penalty to power & bonus
                            If Not CharmName = "Rook Crumble" Then
                                CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), (Power(i, 1) - 2400) * (1 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                            Else
                                If Not rMice(1, j) Like "*Rook" Then
                                    CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), (Power(i, 1) - 2400) * (1 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                                Else
                                    CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), (Power(i, 1) - 2400) * (5 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                                End If
                            End If
                        End If
                    Else ' Technic Side! Yay! pwn it.
                        If Not CharmName = "Rook Crumble" Then
                            CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), (Power(i, 1) + 1800) * (1 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                        Else
                            If Not rMice(1, j) Like "*Rook" Then
                                CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), (Power(i, 1) + 1800) * (1 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                            Else
                                CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), 14), (Power(i, 1) + 1800) * (5 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                            End If
                        End If
                    End If
                Next j
            Case Else 'Not a ZT trap
                For j = 1 To UBound(rMice, 2)
                    If Not CharmName = "Rook Crumble" Then
                        CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                    Else
                        If Not rMice(1, j) Like "*Rook" Then
                            CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                        Else
                            CRC(i, j) = CATCHRATE(allMice(mouserowarray(j), TraptyCol(i)), Power(i, 1) * (5 + Power(i, 2)), Luck(i, 1), rMice(3, j))
                        End If
                    End If
                Next j
            End Select
        Next i
    End If
Case "Crystal Library"
    ' Zurreal's Folly gets a boost vs. Zurreal if the Scholar charm is active
    If Not CharmName Like "Scholar*" Then
        ' No special CR code
        If Not rMice(1, 1) = "" Then
            For j = 1 To UBound(rMice, 2)
                MouseRow = Application.Match(rMice(1, j), Application.Index(allMice, 0, 1), 0)
                For i = 1 To Ubnd
                    CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                Next i
            Next j
        End If
    Else
        ' Zurreal is attractable, so need to give ZF some powah vs. Zurry
        If Not rMice(1, 1) = "" Then
            TrapNames = Range("TrBsTable[Trap]").Value
            For j = 1 To UBound(rMice, 2)
                Select Case rMice(2, j)
                Case "Zurreal - Zurreal"
                    MouseRow = Application.Match(rMice(1, j), Application.Index(allMice, 0, 1), 0)
                    For i = 1 To Ubnd
                        If TrapNames(i, 1) = "Zurreal's Folly" Then
                            ' Need to know the effectiveness - assuming 3000% to start (10/15: changed to 5500%)
                            CRC(i, j) = CATCHRATE(55, Power(i, 3), Luck(i, 1), rMice(3, j))
                        Else
                            CRC(i, j) = 0 'CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                        End If
                    Next i
                Case Else
                    MouseRow = Application.Match(rMice(1, j), Application.Index(allMice, 0, 1), 0)
                    For i = 1 To Ubnd
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                    Next i
                End Select
            Next j
        End If
    End If
Case "Snow Fortress - Throne Room"
    ' Only Nutcracker trap can work vs. Mad Elf Mouse, and nobody should be using anything but it
    If Not rMice(1, 1) = "" Then
        TrapNames = Range("TrBsTable[Trap]").Value
        For j = 1 To UBound(rMice, 2)
            Select Case rMice(2, j)
            Case "Event - Mad Elf"
                MouseRow = Application.Match(rMice(1, j), Application.Index(allMice, 0, 1), 0)
                For i = 1 To Ubnd
                    If TrapNames(i, 1) = "Nutcracker Nuisance" Then
                        CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                    Else
                        CRC(i, j) = 0
                    End If
                Next i
            Case Else
                MouseRow = Application.Match(rMice(1, j), Application.Index(allMice, 0, 1), 0)
                For i = 1 To Ubnd
                    CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
                Next i
            End Select
        Next j
    End If
Case Else
    ' Nothing special, proceed as usual
    If Not rMice(1, 1) = "" Then
        For j = 1 To UBound(rMice, 2)
            MouseRow = Application.Match(rMice(1, j), Application.Index(allMice, 0, 1), 0)
            For i = 1 To Ubnd
                CRC(i, j) = CATCHRATE(allMice(MouseRow, TraptyCol(i)), Power(i, 3), Luck(i, 1), rMice(3, j))
            Next i
        Next j
    End If
End Select
' Adjust this range if moving the table....
Range(Cells(22, 11), Cells(22, 10 + UBound(rMice, 2))).Value = "CR "
With Range(Cells(23, 11), Cells(22 + UBound(CRC, 1), 10 + UBound(rMice, 2)))
    .Value = CRC
    .NumberFormat = "0.0%"
End With
Debug.Print "CRC: " & Format(Timer - stTime, "##0.000") & " seconds"
End Sub
Private Sub CreateSortColumns()
' Created by Ben Hauch 3/24/2012
' Last updated 3/24/2012 by Ben Hauch

Dim ChzEffArr(), StalePrbArr(), tmpStale(), Atr(), CRpH(), CHpH(), rMice()
Dim CheeseCats(), CatchTable(), totAR As Double, PrbAtr As Double
Dim i As Long, j As Integer, nRows As Long, nCols As Integer, output()

' Do we need to create the columns?
If Not Range("TrBsTable[#Headers]").End(xlToRight).Value = "Per Cheese" Then
    Range("TrBsTable[#Headers]").End(xlToRight).Offset(0, 1).Value = "Per Hunt"
    Range("TrBsTable[#Headers]").End(xlToRight).Offset(0, 1).Value = "Per Cheese"
End If

' Load data from worksheets
ChzEffArr = Range("EffectLookup[[Cheese Effect]:[Prb]]").Value
CheeseCats = Application.Index(ChzEffArr, 0, 1)
StalePrbArr = Range("TrBsTable[Cheese Effect]").Value
Atr = Range("TrBsTable[ATR]").Value
totAR = Range("totAR").Value
On Error GoTo exitsub
CatchTable = Range("TrBsTable[[CR ]:[Per Hunt]]").Value
On Error GoTo 0
rMice = Sheets("BestSetup").Range(Cells(8, 11), Cells(8, 11).End(xlToRight)).Value

' Have columns & data, do work.
nRows = UBound(Atr, 1)
nCols = UBound(rMice, 2)
If nCols > 100 Then nCols = 1
ReDim tmpStale(1 To nRows)
ReDim output(1 To nRows, 1 To 2)
' Loop over each setup
For i = 1 To nRows
    ' And then each mouse
    For j = 1 To nCols
        ' Calculate the sumproduct
        output(i, 1) = output(i, 1) + CatchTable(i, j) * rMice(1, j) / 100 * (1 + (100 - totAR) * Atr(i, 1) / totAR)
    Next j
    tmpStale(i) = Application.Match(StalePrbArr(i, 1), CheeseCats, 0)
    PrbAtr = totAR + (100 - totAR) * Atr(i, 1)
    output(i, 2) = output(i, 1) * 100 / (PrbAtr + (100 - PrbAtr) * ChzEffArr(tmpStale(i), 2))
Next i
Range("TrBsTable[[Per Hunt]:[Per Cheese]]").Value = output
exitsub:
On Error GoTo 0
End Sub
Private Function Find_Range(Find_Item As Variant, _
                            Search_Range As Range, _
                            Optional LookIn As Variant, _
                            Optional LookAt As Variant) As Range
Dim c As Range, firstAddress
If IsMissing(LookIn) Then LookIn = xlValues
If IsMissing(LookAt) Then LookAt = xlWhole

With Search_Range
    Set c = .Find(What:=Find_Item, LookIn:=LookIn, LookAt:=LookAt, searchorder:=xlByRows, searchdirection:=xlNext)
    If Not c Is Nothing Then
        Set Find_Range = c
        firstAddress = c.Address
        Do
            Set Find_Range = Union(Find_Range, c)
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
End Function
Private Function GetAutofilterNames() As Variant
' Written by Ben Hauch on 4/13/11
' Last updated by Ben Hauch on 4/16/11

' Determines current active autofilters, if any, and stores them.
' Can store ANY number of autofilters, e.g. not just 1 or 2.

Dim w As Worksheet, strFilterRange$, FilterArray() As Variant, f As Long
Set w = ActiveSheet
With w.AutoFilter
    strFilterRange = .Range.Address
    With .Filters
        ReDim FilterArray(1 To .Count + 1, 1 To 3)
        For f = 2 To .Count + 1
            With .Item(f - 1)
                If .On Then
                    FilterArray(f, 1) = .Criteria1
                    If .Operator Then
                        FilterArray(f, 2) = .Operator
                        On Error Resume Next
                        If Not IsError(.Criteria2) Then FilterArray(f, 3) = .Criteria2
                        On Error GoTo 0
                        End If
                    End If
                End With
            Next f
        End With
    End With
' Store the filtered range in the first index of the returned array
FilterArray(1, 1) = strFilterRange
GetAutofilterNames = FilterArray
End Function
Private Function SetAutofilterNames(FilterArray() As Variant)
' Written by Ben Hauch on 4/13/11
' Last updated by Ben Hauch on 4/16/11

' Restores all autofilters that were saved with GetAutofilterNames

Dim w As Worksheet, col%, strFilterRange$
Set w = ActiveSheet
strFilterRange = FilterArray(1, 1)
FilterArray(1, 1) = Empty
For col = 2 To UBound(FilterArray(), 1)
    If Not IsEmpty(FilterArray(col, 1)) Then
        If FilterArray(col, 2) Then ' An operator is present -> 2 or more criteria
            If IsEmpty(FilterArray(col, 3)) Then 'more than 2 criteria?
            w.Range(strFilterRange).AutoFilter field:=col - 1, _
                Criteria1:=Array(FilterArray(col, 1)), _
                Operator:=FilterArray(col, 2)
            Else 'Exactly two criteria were used
                w.Range(strFilterRange).AutoFilter field:=col - 1, Criteria1:=FilterArray(col, 1), Operator:=FilterArray(col, 2), Criteria2:=FilterArray(col, 3)
                End If
        Else ' No operator -> Single criterion
            w.Range(strFilterRange).AutoFilter field:=col - 1, _
            Criteria1:=FilterArray(col, 1)
            End If
        End If
    Next col
End Function