The cell or chart you're trying to change is on a protected sheet. Error upon placing worksheet Change Selection Code

P

pingme89

Board Regular
Joined
Jan 23, 2014
Messages
176
Office Version
  1. 365
Platform
  1. Windows
I have a workbook with Worksh5heet_SelectionChange code. Below is the Code.
Every Cell on the worksheet is locked except for: Range("D2:D7,B8,C8,D8,F4:F7,H5:H6,H7:I7,L8,M2:M3,M7M6:T6)
Also there is a variable Range which is unlocked: Range("B10:B" & LastLineWithBorder & ",C10:D" & LastLineWithBorder & ",E10:H" & LastLineWithBorder & " J10:L" & LastLineWithBorder & ",P10:P" & LastLineWithBorder)
Where "C10:D10" to "C" & LastLineWithBorder & ":D" & LastLineWithBorder are merged cells

Prior to inserting the code below, I was able to change values in the above unlocked cells. Once I place the below code in the Change Worksheet module, I get the error.
The odd thing is after I get the error, the value I placed there is actually placed in the cell. but I am constantly getting that error for every cell change I get which is not optimal.
Can someone help me troubleshoot the cause and find a solution? The worksheets with this code are Sheets "Q1", "Q2", "Q3", "Q4", "Q5", "Q6", "Q7", and "Q8"

VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim LastRow, i, j, LastRowStock As Long
Dim SheetName, QuoteStockCol, ItemCode As String

CalcM1.TurnOffFunctionality
QLastCalcRow = CalcM2.LastCalcRow
'Protect UserInterfaceOnly:=True
SheetName = ActiveSheet.Name
ThisWorkbook.Worksheets(SheetName).Unprotect Password:=vbNullString
    CurrentRow = ActiveCell.Row
    Application.EnableEvents = True
    If Target.CountLarge > 1 Then Exit Sub
        
        If Not Intersect(Target, Range("U10:V" & QLastCalcRow)) Is Nothing Then
            Me.Unprotect
            Application.EnableEvents = False
            ItemCode = ActiveSheet.Range("E" & CurrentRow)
            'InventoryList.Show
            Application.EnableEvents = True
            Me.Protect
            Application.EnableEvents = True
        End If
  
   If Not Intersect(Target, Range("R10:R" & QLastCalcRow)) Is Nothing Then
      Me.Unprotect
      Application.EnableEvents = False
      Target.value = IIf(Target.value = vbNullString, "P", vbNullString)
      Application.EnableEvents = True
      Me.Protect
      Application.EnableEvents = True
    End If
    On Error Resume Next
    
    If Not Intersect(Target, Range("S10:S" & QLastCalcRow)) Is Nothing Then
      Me.Unprotect
      Application.EnableEvents = False
      Target.value = IIf(Target.value = vbNullString, "R", vbNullString)
      Application.EnableEvents = True
      Me.Protect
      Application.EnableEvents = True
    End If
  
    If Not Intersect(Target, Range("E10:E" & QLastCalcRow)) Is Nothing Then
      Me.Unprotect
      CurrentRow = ActiveCell.Row
      ThisWorkbook.Worksheets(SheetName).Range("E" & CurrentRow).value = Replace(ThisWorkbook.Worksheets(SheetName).Range("E" & CurrentRow).value, " ", vbNullString)
      ThisWorkbook.Worksheets(SheetName).Range("E" & CurrentRow).value = Replace(ThisWorkbook.Worksheets(SheetName).Range("E" & CurrentRow).value, vbLf, vbNullString)
      
    End If
    

With ThisWorkbook.Worksheets(SheetName).Range("R10:S" & QLastCalcRow)
            With .Font
                .Name = "Wingdings 2"
                .FontStyle = "Regular"
                .Size = 13
            End With
End With
ThisWorkbook.Worksheets(SheetName).Range("D2").Locked = False
ThisWorkbook.Worksheets(SheetName).Protect Password:=vbNullString
Application.EnableEvents = True

Application.Calculation = xlAutomatic
CalcM1.TurnOnFunctionality

End Sub


CalcM1.TurnOffFunctionality Code is:

VBA Code: 
Public Sub TurnOffFunctionality()
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
End Sub

CalcM1.TurnOffFunctionality Code is:

VBA Code: 
Public Sub TurnOnFunctionality()
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

CalcM2.LastCalcRow Code is:

VBA Code: 
Public Function LastCalcRow()
Dim Refcolor As Long
ThisWorkbook.Activate
Application.OnTime Now, "RefreshActiveCellSelection"
SheetName = ThisWorkbook.ActiveSheet.Name
SheetName = ActiveSheet.Name

For i = 100 To 10 Step -1
    If ThisWorkbook.Worksheets(SheetName).Range("E" & i).Borders(xlEdgeBottom).LineStyle <> xlNone Then
        LastCalcRow = i
        Exit For
    End If
Next i
ThisWorkbook.Worksheets(SheetName).Unprotect Password:=vbNullString
End Function

I also have code to Create the worksheets:

Code: 
Set wb = Workbooks.Add
FileName = "AnyNameWB"
wb.SaveAs SavePath & "\" & FileName & ".xlsm", FileFormat:=52
wbname = FileName & ".xlsm"
Workbooks(FileName & ".xlsm").Sheets(1).Name = "Q1"
Workbooks(FileName & ".xlsm").Worksheets("Q1").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Q1")).Name = "Q2"
Workbooks(FileName & ".xlsm").Worksheets("Q2").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Q2")).Name = "Q3"
Workbooks(FileName & ".xlsm").Worksheets("Q3").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Q3")).Name = "Q4"
Workbooks(FileName & ".xlsm").Worksheets("Q4").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Q4")).Name = "Q5"
Workbooks(FileName & ".xlsm").Worksheets("Q5").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Q5")).Name = "Q6"
Workbooks(FileName & ".xlsm").Worksheets("Q6").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Q6")).Name = "Q7"
Workbooks(FileName & ".xlsm").Worksheets("Q7").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Q7")).Name = "Q8"
Workbooks(FileName & ".xlsm").Worksheets("Q8").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Q8")).Name = "Dashboard"
Workbooks(FileName & ".xlsm").Worksheets("Dashboard").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Dashboard")).Name = "ClientDB"
Workbooks(FileName & ".xlsm").Worksheets("ClientDB").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("ClientDB")).Name = "DB"
Workbooks(FileName & ".xlsm").Worksheets("DB").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("DB")).Name = "CC Shops"
Workbooks(FileName & ".xlsm").Worksheets("CC Shops").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("CC Shops")).Name = "Purolator Zones"
Workbooks(FileName & ".xlsm").Worksheets("Purolator Zones").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Purolator Zones")).Name = "Purolator Rates"
Workbooks(FileName & ".xlsm").Worksheets("Purolator Rates").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Purolator Rates")).Name = "FedExZones"
Workbooks(FileName & ".xlsm").Worksheets("FedExZones").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("FedExZones")).Name = "FedExRateScale"
Workbooks(FileName & ".xlsm").Worksheets("FedExRateScale").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("FedExRateScale")).Name = "FedExRates"
Workbooks(FileName & ".xlsm").Worksheets("FedExRates").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("FedExRates")).Name = "UPS Zones"
Workbooks(FileName & ".xlsm").Worksheets("UPS Zones").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("UPS Zones")).Name = "UPS Rates"
Workbooks(FileName & ".xlsm").Worksheets("UPS Rates").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("UPS Rates")).Name = "UPS Price List"
Workbooks(FileName & ".xlsm").Worksheets("UPS Price List").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("UPS Price List")).Name = "Labour"
Workbooks(FileName & ".xlsm").Worksheets("Labour").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Labour")).Name = "Vendors"
Workbooks(FileName & ".xlsm").Worksheets("Vendors").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Vendors")).Name = "ERP HTML Code"
Workbooks(FileName & ".xlsm").Worksheets("ERP HTML Code").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("ERP HTML Code")).Name = "Email Templates"
Workbooks(FileName & ".xlsm").Worksheets("Email Templates").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Email Templates")).Name = "Video Camera Calc"
Workbooks(FileName & ".xlsm").Worksheets("Video Camera Calc").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Video Camera Calc")).Name = "Software Licenses"
Workbooks(FileName & ".xlsm").Worksheets("Software Licenses").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Software Licenses")).Name = "Music Marketing"
Workbooks(FileName & ".xlsm").Worksheets("Music Marketing").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Music Marketing")).Name = "Calc Parameters"
Workbooks(FileName & ".xlsm").Worksheets("Calc Parameters").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Calc Parameters")).Name = "Raw Stock Data"
Workbooks(FileName & ".xlsm").Worksheets("Raw Stock Data").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Raw Stock Data")).Name = "SQLQuoteLogStaging"
Workbooks(FileName & ".xlsm").Worksheets("SQLQuoteLogStaging").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("SQLQuoteLogStaging")).Name = "SQL StagingQO"
Workbooks(FileName & ".xlsm").Worksheets("SQL StagingQO").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("SQL StagingQO")).Name = "SQL Staging"
Workbooks(FileName & ".xlsm").Worksheets("SQL Staging").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("SQL Staging")).Name = "STR"
Workbooks(FileName & ".xlsm").Worksheets("STR").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("STR")).Name = "Pick List"
Workbooks(FileName & ".xlsm").Worksheets("Pick List").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("Pick List")).Name = "PriceOverride"
Workbooks(FileName & ".xlsm").Worksheets("PriceOverride").Cells.Interior.Color = RGB(255, 255, 255)
Workbooks(FileName & ".xlsm").Sheets.Add(after:=Sheets("PriceOverride")).Name = "Refund Request"
Workbooks(FileName & ".xlsm").Worksheets("Refund Request").Cells.Interior.Color = RGB(255, 255, 255)

Workbooks(FileName & ".xlsm").Worksheets("FedExZones").Visible = xlSheetHidden
Workbooks(FileName & ".xlsm").Worksheets("FedExRateScale").Visible = xlSheetHidden
Workbooks(FileName & ".xlsm").Worksheets("FedExRates").Visible = xlSheetHidden
Workbooks(FileName & ".xlsm").Worksheets("UPS Rates").Visible = xlSheetHidden
Workbooks(FileName & ".xlsm").Worksheets("UPS Zones").Visible = xlSheetHidden
Workbooks(FileName & ".xlsm").Worksheets("UPS Price List").Visible = xlSheetHidden
Workbooks(FileName & ".xlsm").Worksheets("Raw Stock Data").Visible = xlSheetHidden
Workbooks(FileName & ".xlsm").Worksheets("STR").Visible = xlSheetHidden
Workbooks(FileName & ".xlsm").Worksheets("SQL Staging").Visible = xlSheetHidden
Workbooks(FileName & ".xlsm").Worksheets("Music Marketing").Visible = xlSheetHidden
Workbooks(FileName & ".xlsm").Worksheets("Software Licenses").Visible = xlSheetHidden
Workbooks(FileName & ".xlsm").Worksheets("Video Camera Calc").Visible = xlSheetHidden
Workbooks(FileName & ".xlsm").Worksheets("DB").Visible = xlSheetHidden
Workbooks(FileName & ".xlsm").Worksheets("Dashboard").Tab.ColorIndex = 6
Workbooks(FileName & ".xlsm").Worksheets("Q1").Tab.ColorIndex = 37
Workbooks(FileName & ".xlsm").Worksheets("Q2").Tab.ColorIndex = 3
Workbooks(FileName & ".xlsm").Worksheets("Q3").Tab.ColorIndex = 37
Workbooks(FileName & ".xlsm").Worksheets("Q4").Tab.ColorIndex = 3
Workbooks(FileName & ".xlsm").Worksheets("Q5").Tab.ColorIndex = 37
Workbooks(FileName & ".xlsm").Worksheets("Q6").Tab.ColorIndex = 3
Workbooks(FileName & ".xlsm").Worksheets("Q7").Tab.ColorIndex = 37
Workbooks(FileName & ".xlsm").Worksheets("Q8").Tab.ColorIndex = 3

To add Named Ranges:
VBA Code: 
Public Sub AddNamedRanges()

wbname =  "AnyNameWB.xlsm"
Set WBD = Workbooks(wbname)

'CompanyData
WBD.Names.Add Name:="CompanyData", RefersTo:="=OFFSET('ClientDB'!$A$2,0,0,COUNTA('ClientDB'!$A$2:$A50000),13)"
'TradeName
WBD.Names.Add Name:="TradeName", RefersTo:="=OFFSET('ClientDB'!$A$2,0,0,COUNTA('ClientDB'!$A$2:$A50000),1)"
'CustomerCode
WBD.Names.Add Name:="CustomerCode", RefersTo:="=OFFSET('ClientDB'!$C$2,0,0,COUNTA('ClientDB'!$C$2:$C50000),1)"
'Action List
WBD.Names.Add Name:="ActionList", RefersTo:="=OFFSET('Calc Parameters'!$C$1,0,0,COUNTA('Calc Parameters'!$C$1:$C50000),1)"
'ActionMSGDB
WBD.Names.Add Name:="ActionMSGDB", RefersTo:="=OFFSET('Calc Parameters'!$C$1,0,0,COUNTA('Calc Parameters'!$C$1:$C50000),2)"
'LegalName
WBD.Names.Add Name:="LegalName", RefersTo:="=OFFSET('ClientDB'!$B$2,0,0,COUNTA('ClientDB'!$B$2:$B50000),1)"
'CCStoreDB
WBD.Names.Add Name:="CCStoreDB", RefersTo:="=OFFSET('CC Shops'!$A$2,0,0,COUNTA('CC Shops'!$B$2:$B50000),8)"
'CCStoreName
WBD.Names.Add Name:="CCStoreName", RefersTo:="=OFFSET('CC Shops'!$B$2,0,0,COUNTA('CC Shops'!$B$2:$B50000),1)"
'CCStoreNumber
WBD.Names.Add Name:="CCStoreNumber", RefersTo:="=OFFSET('CC Shops'!$A$2,0,0,COUNTA('CC Shops'!$B$2:$B50000),1)"
'CCStorePhone
WBD.Names.Add Name:="CCStorePhone", RefersTo:="=OFFSET('CC Shops'!$G$2,0,0,COUNTA('CC Shops'!$B$2:$B50000),1)"
'LabourDB
WBD.Names.Add Name:="LabourDB", RefersTo:="=Labour!$A$1:$C$17"
'LabourList
WBD.Names.Add Name:="LabourList", RefersTo:="=Labour!$B$1:$B$17"
'Q1QTYtotal
WBD.Names.Add Name:="Q1QTYtotal", RefersTo:="=OFFSET('Q1'!$B$10, 0, 0, COUNTA('Q1'!$B$10:$B$10000),1 )"
'Q1TotalFlat
WBD.Names.Add Name:="Q1TotalFlat", RefersTo:="=OFFSET('Q1'!$DE$10, 0, 0, COUNTA('Q1'!$DE$10:$DE$10000),1 )"
'Q1TotalLarge
WBD.Names.Add Name:="Q1TotalLarge", RefersTo:="=OFFSET('Q1'!$DD$10, 0, 0, COUNTA('Q1'!$DD$10:$DD$10000),1 )"
'Q1QTYTotalOversize
WBD.Names.Add Name:="Q1QTYTotalOversize", RefersTo:="=OFFSET('Q1'!$DC$10, 0, 0, COUNTA('Q1'!$DC$10:$DC$10000),1 )"
'Q2QTYtotal
WBD.Names.Add Name:="Q2QTYtotal", RefersTo:="=OFFSET('Q2'!$B$10, 0, 0, COUNTA('Q2'!$B$10:$B$10000),1 )"
'Q2TotalFlat
WBD.Names.Add Name:="Q2TotalFlat", RefersTo:="=OFFSET('Q2'!$DE$10, 0, 0, COUNTA('Q2'!$DE$10:$DE$10000),1 )"
'Q2TotalLarge
WBD.Names.Add Name:="Q2TotalLarge", RefersTo:="=OFFSET('Q2'!$DD$10, 0, 0, COUNTA('Q2'!$DD$10:$DD$10000),1 )"
'Q2QTYTotalOversize
WBD.Names.Add Name:="Q2QTYTotalOversize", RefersTo:="=OFFSET('Q2'!$DC$10, 0, 0, COUNTA('Q2'!$DC$10:$DC$10000),1 )"
'Q3QTYtotal
WBD.Names.Add Name:="Q3QTYtotal", RefersTo:="=OFFSET('Q3'!$B$10, 0, 0, COUNTA('Q3'!$B$10:$B$10000),1 )"
'Q3TotalFlat
WBD.Names.Add Name:="Q3TotalFlat", RefersTo:="=OFFSET('Q3'!$DE$10, 0, 0, COUNTA('Q3'!$DE$10:$DE$10000),1 )"
'Q3TotalLarge
WBD.Names.Add Name:="Q3TotalLarge", RefersTo:="=OFFSET('Q3'!$DD$10, 0, 0, COUNTA('Q3'!$DD$10:$DD$10000),1 )"
'Q3QTYTotalOversize
WBD.Names.Add Name:="Q3QTYTotalOversize", RefersTo:="=OFFSET('Q3'!$DC$10, 0, 0, COUNTA('Q3'!$DC$10:$DC$10000),1 )"
'Q4QTYtotal
WBD.Names.Add Name:="Q4QTYtotal", RefersTo:="=OFFSET('Q4'!$B$10, 0, 0, COUNTA('Q4'!$B$10:$B$10000),1 )"
'Q4TotalFlat
WBD.Names.Add Name:="Q4TotalFlat", RefersTo:="=OFFSET('Q4'!$DE$10, 0, 0, COUNTA('Q4'!$DE$10:$DE$10000),1 )"
'Q4TotalLarge
WBD.Names.Add Name:="Q4TotalLarge", RefersTo:="=OFFSET('Q4'!$DD$10, 0, 0, COUNTA('Q4'!$DD$10:$DD$10000),1 )"
'Q4QTYTotalOversize
WBD.Names.Add Name:="Q4QTYTotalOversize", RefersTo:="=OFFSET('Q4'!$DC$10, 0, 0, COUNTA('Q4'!$DC$10:$DC$10000),1 )"
'Q5QTYtotal
WBD.Names.Add Name:="Q5QTYtotal", RefersTo:="=OFFSET('Q5'!$B$10, 0, 0, COUNTA('Q5'!$B$10:$B$10000),1 )"
'Q5TotalFlat
WBD.Names.Add Name:="Q5TotalFlat", RefersTo:="=OFFSET('Q5'!$DE$10, 0, 0, COUNTA('Q5'!$DE$10:$DE$10000),1 )"
'Q5TotalLarge
WBD.Names.Add Name:="Q5TotalLarge", RefersTo:="=OFFSET('Q5'!$DD$10, 0, 0, COUNTA('Q5'!$DD$10:$DD$10000),1 )"
'Q5QTYTotalOversize
WBD.Names.Add Name:="Q5QTYTotalOversize", RefersTo:="=OFFSET('Q5'!$DC$10, 0, 0, COUNTA('Q5'!$DC$10:$DC$10000),1 )"
'Q6QTYtotal
WBD.Names.Add Name:="Q6QTYtotal", RefersTo:="=OFFSET('Q6'!$B$10, 0, 0, COUNTA('Q6'!$B$10:$B$10000),1 )"
'Q6TotalFlat
WBD.Names.Add Name:="Q6TotalFlat", RefersTo:="=OFFSET('Q6'!$DE$10, 0, 0, COUNTA('Q6'!$DE$10:$DE$10000),1 )"
'Q6TotalLarge
WBD.Names.Add Name:="Q6TotalLarge", RefersTo:="=OFFSET('Q6'!$DD$10, 0, 0, COUNTA('Q6'!$DD$10:$DD$10000),1 )"
'Q6QTYTotalOversize
WBD.Names.Add Name:="Q6QTYTotalOversize", RefersTo:="=OFFSET('Q6'!$DC$10, 0, 0, COUNTA('Q6'!$DC$10:$DC$10000),1 )"
'Q7QTYtotal
WBD.Names.Add Name:="Q7QTYtotal", RefersTo:="=OFFSET('Q7'!$B$10, 0, 0, COUNTA('Q7'!$B$10:$B$10000),1 )"
'Q7TotalFlat
WBD.Names.Add Name:="Q7TotalFlat", RefersTo:="=OFFSET('Q7'!$DE$10, 0, 0, COUNTA('Q7'!$DE$10:$DE$10000),1 )"
'Q7TotalLarge
WBD.Names.Add Name:="Q7TotalLarge", RefersTo:="=OFFSET('Q7'!$DD$10, 0, 0, COUNTA('Q7'!$DD$10:$DD$10000),1 )"
'Q7QTYTotalOversize
WBD.Names.Add Name:="Q7QTYTotalOversize", RefersTo:="=OFFSET('Q7'!$DC$10, 0, 0, COUNTA('Q7'!$DC$10:$DC$10000),1 )"
'Q8QTYtotal
WBD.Names.Add Name:="Q8QTYtotal", RefersTo:="=OFFSET('Q8'!$B$10, 0, 0, COUNTA('Q8'!$B$10:$B$10000),1 )"
'Q8TotalFlat
WBD.Names.Add Name:="Q8TotalFlat", RefersTo:="=OFFSET('Q8'!$DE$10, 0, 0, COUNTA('Q8'!$DE$10:$DE$10000),1 )"
'Q8TotalLarge
WBD.Names.Add Name:="Q8TotalLarge", RefersTo:="=OFFSET('Q8'!$DD$10, 0, 0, COUNTA('Q8'!$DD$10:$DD$10000),1 )"
'Q8QTYTotalOversize
WBD.Names.Add Name:="Q8QTYTotalOversize", RefersTo:="=OFFSET('Q8'!$DC$10, 0, 0, COUNTA('Q8'!$DC$10:$DC$10000),1 )"
'QLOGDB
WBD.Names.Add Name:="QLOGDB", RefersTo:="=OFFSET(DB!$A$1,0,0,COUNTA(DB!$A$1:$A50000),21)"
'QlogQOnum
WBD.Names.Add Name:="QlogQOnum", RefersTo:="=OFFSET(DB!$A$1,0,0,COUNTA(DB!$A$1:$A50000),1)"
'QuoteLogDB
WBD.Names.Add Name:="QuoteLogDB", RefersTo:="=OFFSET(SQLQuoteLogStaging!$A$1,0,0,COUNTA(SQLQuoteLogStaging!$A$1:$A50000),60)"
'QuoteLogQO
WBD.Names.Add Name:="QuoteLogQO", RefersTo:="=OFFSET(SQLQuoteLogStaging!$B$1,0,0,COUNTA(SQLQuoteLogStaging!$B$1:$B50000),1)"
'ShipStoreData
WBD.Names.Add Name:="ShipStoreData", RefersTo:="=OFFSET('ERP HTML Code'!$A$1,0,0,COUNTA('ERP HTML Code'!$A$1:$A50000),2)"
'ShipStores
WBD.Names.Add Name:="ShipStores", RefersTo:="=OFFSET('ERP HTML Code'!$A$1,0,0,COUNTA('ERP HTML Code'!$A$1:$A50000),1)"
'SHIPVIA
WBD.Names.Add Name:="SHIPVIA", RefersTo:="='Calc Parameters'!$AK$1:$AK$6"
'ShipViaHTMLData
WBD.Names.Add Name:="ShipViaHTMLData", RefersTo:="=OFFSET('ERP HTML Code'!$D$1,0,0,COUNTA('ERP HTML Code'!$D$1:$D50000),2)"
'ShipViaLocation
WBD.Names.Add Name:="ShipViaLocation", RefersTo:="=OFFSET('ERP HTML Code'!$D$1,0,0,COUNTA('ERP HTML Code'!$D$1:$D50000),1)"
'ShipViaXpath
WBD.Names.Add Name:="ShipViaXpath", RefersTo:="=OFFSET('ERP HTML Code'!$E$1,0,0,COUNTA('ERP HTML Code'!$E$1:$E50000),1)"
'SoftWareDB
WBD.Names.Add Name:="SoftWareDB", RefersTo:="=OFFSET('Software Licenses'!$B$2,0,0,COUNTA('Software Licenses'!$B$2:CI10000),7)"
'SoftwareFiltered
WBD.Names.Add Name:="SoftwareFiltered", RefersTo:="=OFFSET('Software Licenses'!$AA$1,0,0,COUNTA('Software Licenses'!$AA$1:$AG10000),7)"
'SoftwareVendorListRange
WBD.Names.Add Name:="SoftwareVendorListRange", RefersTo:="=OFFSET('Software Licenses'!$A$2,0,0,COUNTA('Software Licenses'!$A$2:$A2000),1)"
'TaxDB
WBD.Names.Add Name:="TaxDB", RefersTo:="='Calc Parameters'!$AF$1:$AG$12"
'TradeName
WBD.Names.Add Name:="TradeName", RefersTo:="=OFFSET(ClientDB!$A$2,0,0,COUNTA(ClientDB!$A$2:$A50000),1)"
'TXProvince
WBD.Names.Add Name:="TXProvince", RefersTo:="='Calc Parameters'!$AF$1:$AF$12"
'VendorList
WBD.Names.Add Name:="VendorList", RefersTo:="=OFFSET('Calc Parameters'!$A$2,0,0,COUNTA('Calc Parameters'!$A$2:$A$50000),1)"


End Sub

Code to Add Formulas on Worksheets:

Code: 
Public Sub RestoreCheck()
' Working Code to restore all Function, formats, and conditional formatting to all Quote Pages
' This procedure adds conditional formatting to each cell
' Formulas are restored
Dim ar(1 To 22)
Dim c As Integer
Dim cnt As Integer
Dim SheetName As String
TurnOffFunctionality
wbname = "AnyNameWB.xlsm"
MacroName = "QRestoreCheck"
Set WBD = Workbooks(wbname)
For i = 1 To 8
    SheetName = "Q" & i
    WBD.Worksheets(SheetName).Unprotect Password:=vbNullString
    WBD.Worksheets(SheetName).Activate
    QLastItemRow = LastItemRow
    QLastCalcRow = LastCalcRow
    WBD.Worksheets(SheetName).Range("J7:L7").Merge
    WBD.Worksheets(SheetName).Range("D4").Font.Color = RGB(47, 117, 181)
    WBD.Worksheets(SheetName).Range("D5").Font.Color = RGB(112, 48, 160)
    With WBD.Worksheets(SheetName).Range("J7:L7")                                             ' Add conditioanal format for Cell (J7:L7) : Order Status
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="= J7 = " & Chr(34) & "Quoted" & Chr(34)
        .FormatConditions(1).Interior.Color = RGB(255, 242, 204)
        .FormatConditions(1).Font.Color = RGB(0, 0, 0)
        .FormatConditions(1).StopIfTrue = False
        .Locked = False
    End With
    
    With WBD.Worksheets(SheetName).Range("J7:L7")
        .FormatConditions.Add Type:=xlExpression, Formula1:="= J7= " & Chr(34) & "Original" & Chr(34)
        .FormatConditions(2).Interior.Color = RGB(226, 239, 218)
        .FormatConditions(2).Font.Color = RGB(0, 0, 0)
        .FormatConditions(2).StopIfTrue = False
    End With
    
    With WBD.Worksheets(SheetName).Range("J7:L7")
         .FormatConditions.Add Type:=xlExpression, Formula1:="= J7= " & Chr(34) & "Picked" & Chr(34)
         .FormatConditions(3).Interior.Color = RGB(47, 117, 181)
         .FormatConditions(3).Font.Color = RGB(255, 255, 255)
         .FormatConditions(3).StopIfTrue = False
    End With
    
    With WBD.Worksheets(SheetName).Range("J7:L7")
         .FormatConditions.Add Type:=xlExpression, Formula1:="= J7= " & Chr(34) & "Cancel Confirmed" & Chr(34)
         .FormatConditions(4).Interior.Color = RGB(255, 0, 0)
         .FormatConditions(4).Font.Color = RGB(0, 0, 0)
         .FormatConditions(4).StopIfTrue = False
    End With
    
    With WBD.Worksheets(SheetName).Range("J7:L7")
         .FormatConditions.Add Type:=xlExpression, Formula1:="= J7= " & Chr(34) & "Shipped Out" & Chr(34)
         .FormatConditions(5).Interior.Color = RGB(146, 208, 80)
         .FormatConditions(5).Font.Color = RGB(255, 255, 255)
         .FormatConditions(5).StopIfTrue = False
    End With
    
    With WBD.Worksheets(SheetName).Range("J7:L7")
         .FormatConditions.Add Type:=xlExpression, Formula1:="= J7= " & Chr(34) & "Payment Confirmed" & Chr(34)
         .FormatConditions(6).Interior.Color = RGB(255, 217, 102)
         .FormatConditions(6).Font.Color = RGB(48, 84, 150)
         .FormatConditions(6).StopIfTrue = False
    End With
    
    With WBD.Worksheets(SheetName).Range("J7:L7")
         .FormatConditions.Add Type:=xlExpression, Formula1:="=J7= " & Chr(34) & "Quote Lost" & Chr(34)
         .FormatConditions(7).Interior.Color = RGB(231, 230, 230)
         .FormatConditions(7).Font.Color = RGB(255, 0, 0)
         .FormatConditions(7).StopIfTrue = False
    End With
    WBD.Worksheets(SheetName).Range("H7:I7").Merge
    WBD.Worksheets(SheetName).Range("H7:I7").HorizontalAlignment = xlLeft
    WBD.Worksheets(SheetName).Range("J7:L7").HorizontalAlignment = xlCenter
    WBD.Worksheets(SheetName).Range("D3").Formula = "=INDEX(CompanyData,MATCH(D2,TradeName,0),3)"      ' Restores Company Information and Ship To Address
    
    WBD.Worksheets(SheetName).Range("H2").Formula = "=INDEX(CompanyData,MATCH(D2,TradeName,0),6)"
    WBD.Worksheets(SheetName).Range("H3").Formula = "=INDEX(CompanyData,MATCH(D2,TradeName,0),9)"
    WBD.Worksheets(SheetName).Range("H5").Formula = "=INDEX(CompanyData,MATCH(D2,TradeName,0),8)"
    WBD.Worksheets(SheetName).Range("H6").Formula = "=INDEX(CompanyData,MATCH(D2,TradeName,0),7)"
    WBD.Worksheets(SheetName).Range("H7").Formula = "=INDEX(CompanyData,MATCH(D2,TradeName,0),9)"
    WBD.Worksheets(SheetName).Range("F1").Formula = "=INDEX(CompanyData,MATCH(D2,TradeName,0),10)"
    WBD.Worksheets(SheetName).Range("F2").Formula = "=INDEX(CompanyData,MATCH(D2,TradeName,0),1)"
    WBD.Worksheets(SheetName).Range("F3").Formula = "=INDEX(CompanyData,MATCH(D2,TradeName,0),4)"
    WBD.Worksheets(SheetName).Range("F4").Formula = "=INDEX(CompanyData,MATCH(D2,TradeName,0),1)"
    WBD.Worksheets(SheetName).Range("F5").Formula = "=INDEX(CompanyData,MATCH(D2,TradeName,0),5)"
    WBD.Worksheets(SheetName).Range("F6").Formula = "=INDEX(CompanyData,MATCH(D2,TradeName,0),6)"
    WBD.Worksheets(SheetName).Range("F7").Formula = "=INDEX(CompanyData,MATCH(D2,TradeName,0),4)"
    WBD.Worksheets(SheetName).Range("C8").Formula = "=INDEX(LabourDB,MATCH(D8,LabourList,0),1)"
    WBD.Worksheets(SheetName).Range("J1").Formula = "=INDEX(CCStoreDB,MATCH(J2,CCStoreName,0),1)"
    WBD.Worksheets(SheetName).Range("J3").Formula = "=INDEX(CCStoreDB,MATCH(J2,CCStoreName,0),3)"
    WBD.Worksheets(SheetName).Range("J4").Formula = "=INDEX(CCStoreDB,MATCH(J2,CCStoreName,0),4)"
    WBD.Worksheets(SheetName).Range("J5").Formula = "=INDEX(CCStoreDB,MATCH(J2,CCStoreName,0),5)"
    WBD.Worksheets(SheetName).Range("J6").Formula = "=INDEX(CCStoreDB,MATCH(J2,CCStoreName,0),7)"
    WBD.Worksheets(SheetName).Range("M6").Formula = "=SUM(Y:Y)"                                        ' Weight
    
    WBD.Worksheets(SheetName).Range("O6").Formula = "=SUM(N10:N20)+SUM(J10:J20)+SUM(K10:K20)"          ' Subtotal
    WBD.Worksheets(SheetName).Range("Q6").Formula = "=SUM(N10:N20)-SUM(M10:M20)"                       ' Total Profit
    WBD.Worksheets(SheetName).Range("R6").Formula = "=IF(ISERROR(Q6/O6),0,Q6/O6)"                      ' Overall Margin
    
    
    WBD.Worksheets(SheetName).Range("F1:H7").HorizontalAlignment = xlLeft
    WBD.Worksheets(SheetName).Range("G3").HorizontalAlignment = xlCenter
    For j = 1 To 8
        If WBD.Worksheets(SheetName).Range("D" & j).HasFormula = True And j = 3 Then
            With WBD.Worksheets(SheetName).Range("D" & j)
                .FormatConditions.Delete
                .FormatConditions.Add Type:=xlExpression, Formula1:="=ISERROR(D" & j & ")"
                .FormatConditions(WBD.Worksheets(SheetName).Range("D" & j).FormatConditions.count).SetFirstPriority
                .FormatConditions(1).Interior.Color = RGB(255, 255, 255)
                .FormatConditions(1).Font.Color = RGB(255, 255, 255)
                .FormatConditions(1).StopIfTrue = False
            End With
        With WBD.Worksheets(SheetName).Range("D" & j)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=D" & j & "=0"
            .FormatConditions(WBD.Worksheets(SheetName).Range("D" & j).FormatConditions.count).Interior.Color = RGB(255, 255, 255)
            .FormatConditions(WBD.Worksheets(SheetName).Range("D" & j).FormatConditions.count).Font.Color = RGB(255, 255, 255)
            .FormatConditions(WBD.Worksheets(SheetName).Range("D" & j).FormatConditions.count).StopIfTrue = False
        End With
            
        End If
        WBD.Worksheets(SheetName).Range("D" & j).Font.Color = vbBlack
        If j = 1 Then
            Col = 10
        ElseIf j = 2 Then
            Col = 1
        ElseIf j = 3 Then
            Col = 4
        ElseIf j = 4 Then
            Col = 1
        ElseIf j = 5 Then
            Col = 5
        ElseIf j = 6 Then
            Col = 6
        ElseIf j = 7 Then
            Col = 4
        End If
        If WBD.Worksheets(SheetName).Range("F" & j).HasFormula = True And j < 8 Then
            With WBD.Worksheets(SheetName).Range("F" & j)
                .FormatConditions.Delete
                b = "=ISERROR(F" & j & ")"
                .FormatConditions.Add Type:=xlExpression, Formula1:="=ISERROR(F" & j & ")"
                .FormatConditions(WBD.Worksheets(SheetName).Range("F" & j).FormatConditions.count).SetFirstPriority
                .FormatConditions(1).Interior.Color = RGB(255, 255, 255)
                .FormatConditions(1).Font.Color = RGB(255, 255, 255)
                .FormatConditions(1).StopIfTrue = False
            End With
        With WBD.Worksheets(SheetName).Range("F" & j)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=F" & j & "=0"
            .FormatConditions(WBD.Worksheets(SheetName).Range("F" & j).FormatConditions.count).Interior.Color = RGB(255, 255, 255)
            .FormatConditions(WBD.Worksheets(SheetName).Range("F" & j).FormatConditions.count).Font.Color = RGB(255, 255, 255)
            .FormatConditions(WBD.Worksheets(SheetName).Range("F" & j).FormatConditions.count).StopIfTrue = False
        End With
            If j > 3 And j < 8 Then
                WBD.Worksheets(SheetName).Range("F" & j & ",H" & j).Font.Color = RGB(47, 117, 181)
            End If
        End If
        WBD.Worksheets(SheetName).Range("F" & j).Font.Color = vbBlack
        If j = 2 Then
            Col = 6
        ElseIf j = 3 Then
            Col = 9
        ElseIf j = 5 Then
            Col = 8
        ElseIf j = 6 Then
            Col = 7
        ElseIf j = 7 Then
            Col = 9
        End If
        If WBD.Worksheets(SheetName).Range("H" & j).HasFormula = True And j > 1 And j < 8 And j <> 4 Then
            With WBD.Worksheets(SheetName).Range("H" & j)
                .FormatConditions.Delete
                .FormatConditions.Add Type:=xlExpression, Formula1:="=ISERROR(H" & j & ")"
                .FormatConditions(WBD.Worksheets(SheetName).Range("H" & j).FormatConditions.count).SetFirstPriority
                .FormatConditions(1).Interior.Color = RGB(255, 255, 255)
                .FormatConditions(1).Font.Color = RGB(255, 255, 255)
                .FormatConditions(1).StopIfTrue = False
            End With
        With WBD.Worksheets(SheetName).Range("H" & j)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=H" & j & "=0"
            .FormatConditions(WBD.Worksheets(SheetName).Range("H" & j).FormatConditions.count).Interior.Color = RGB(255, 255, 255)
            .FormatConditions(WBD.Worksheets(SheetName).Range("H" & j).FormatConditions.count).Font.Color = RGB(255, 255, 255)
            .FormatConditions(WBD.Worksheets(SheetName).Range("H" & j).FormatConditions.count).StopIfTrue = False
        End With
                If j > 4 And j < 8 Then
                WBD.Worksheets(SheetName).Range("F" & j).Font.Color = RGB(47, 117, 181)
            End If
        End If
            WBD.Worksheets(SheetName).Range("H" & j).Font.Color = vbBlack
        If j = 1 Then
            Col = 1
        ElseIf j = 3 Then
            Col = 3
        ElseIf j = 4 Then
            Col = 4
        ElseIf j = 5 Then
            Col = 5
        ElseIf j = 6 Then
            Col = 7
        ElseIf j = 7 Then
            Col = 4
        End If
        If WBD.Worksheets(SheetName).Range("J" & j).HasFormula = True And j < 7 Then
            With WBD.Worksheets(SheetName).Range("J" & j)
                .FormatConditions.Delete
                .FormatConditions.Add Type:=xlExpression, Formula1:="=ISERROR(J" & j & ")"
                .FormatConditions(WBD.Worksheets(SheetName).Range("J" & j).FormatConditions.count).SetFirstPriority
                .FormatConditions(1).Interior.Color = RGB(255, 255, 255)
                .FormatConditions(1).Font.Color = RGB(255, 255, 255)
                .FormatConditions(1).StopIfTrue = False
            End With
        WBD.Worksheets(SheetName).Range("J" & j).Font.Color = vbBlack
        End If
    Next j
    WBD.Worksheets(SheetName).Range("H4,A10").Font.Color = vbRed
    WBD.Worksheets(SheetName).Range("A10").value = "*"
    WBD.Worksheets(SheetName).Range("A10").HorizontalAlignment = xlCenter
    WBD.Worksheets(SheetName).Range("A10").VerticalAlignment = xlCenter
    WBD.Worksheets(SheetName).Range("A10").Font.Bold = True
    WBD.Worksheets(SheetName).Range("A10").Font.Name = "Adobe Myungjo Std M"
    WBD.Worksheets(SheetName).Range("A10").Font.Size = 18
    If SheetName = "Q1" Then
        FreightFormula = "=ISERROR(IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!B215,0),'Purolator Rates'!B215))=true"
        WBD.Sheets("Q1").Range("N6").Formula = "=IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!B215,0),'Purolator Rates'!B215)"
        WBD.Worksheets("Q1").Range("P6").Formula = "=O6*(1+'Calc Parameters'!AG16)"
    ElseIf SheetName = "Q2" Then
        FreightFormula = "=ISERROR(IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!C215,0),'Purolator Rates'!C215))=true"
        WBD.Sheets("Q2").Range("N6").Formula = "=IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!C215,0),'Purolator Rates'!C215)"
        WBD.Worksheets("Q2").Range("P6").Formula = "=O6*(1+'Calc Parameters'!AG17)"
    ElseIf SheetName = "Q3" Then
        FreightFormula = "=ISERROR(IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!D215,0),'Purolator Rates'!D215))=true"
        WBD.Sheets("Q3").Range("N6").Formula = "=IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!D215,0),'Purolator Rates'!D215)"
        WBD.Worksheets("Q3").Range("P6").Formula = "=O6*(1+'Calc Parameters'!AG18)"
    ElseIf SheetName = "Q4" Then
        FreightFormula = "=ISERROR(IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!E215,0),'Purolator Rates'!E215))=true"
        WBD.Sheets("Q4").Range("N6").Formula = "=IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!E215,0),'Purolator Rates'!E215)"
        WBD.Worksheets("Q4").Range("P6").Formula = "=O6*(1+'Calc Parameters'!AG19)"
    ElseIf SheetName = "Q5" Then
        FreightFormula = "=ISERROR(IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!F215,0),'Purolator Rates'!F215))=true"
        WBD.Sheets("Q5").Range("N6").Formula = "=IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!F215,0),'Purolator Rates'!F215)"
        WBD.Worksheets("Q5").Range("P6").Formula = "=O6*(1+'Calc Parameters'!AG20)"
    ElseIf SheetName = "Q6" Then
        FreightFormula = "=ISERROR(IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!G215,0),'Purolator Rates'!G215))=true"
        WBD.Sheets("Q6").Range("N6").Formula = "=IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!G215,0),'Purolator Rates'!G215)"
        WBD.Worksheets("Q6").Range("P6").Formula = "=O6*(1+'Calc Parameters'!AG21)"
    ElseIf SheetName = "Q7" Then
        FreightFormula = "=ISERROR(IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!H215,0),'Purolator Rates'!H215))=true"
        WBD.Sheets("Q7").Range("N6").Formula = "=IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!H215,0),'Purolator Rates'!H215)"
        WBD.Worksheets("Q7").Range("P6").Formula = "=O6*(1+'Calc Parameters'!AG22)"
    ElseIf SheetName = "Q8" Then
        FreightFormula = "=ISERROR(IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!I215,0),'Purolator Rates'!I215))=true"
        WBD.Sheets("Q8").Range("N6").Formula = "=IF('Calc Parameters'!T2=" & Chr(34) & "Yes" & Chr(34) & ",ROUNDUP('Purolator Rates'!I215,0),'Purolator Rates'!I215)"
        WBD.Worksheets("Q8").Range("P6").Formula = "=O6*(1+'Calc Parameters'!AG23)"
    End If
    'Sheets(SheetName).Unprotect Password:=""
    With WBD.Worksheets(SheetName).Range("N6")
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=FreightFormula
        .FormatConditions(WBD.Worksheets(SheetName).Range("N6").FormatConditions.count).SetFirstPriority
        .FormatConditions(1).Interior.Color = RGB(255, 255, 255)
        .FormatConditions(1).Font.Color = RGB(255, 255, 255)
        .FormatConditions(1).StopIfTrue = False
    End With
    
    
    
    For j = 10 To QLastCalcRow                                              ' Restores Formulas in Quote Section with conditional formatting
        WBD.Worksheets(SheetName).Range("F" & j).Formula = "=AE" & j                                                                                                                                                       ' Landed Price
        WBD.Worksheets(SheetName).Range("I" & j).Formula = "=F" & j & "-(G" & j & "*H" & j & ")"                                                                                                                           ' Acutal Cost
        WBD.Worksheets(SheetName).Range("L" & j).Formula = "=IF(OR(AND(TODAY()>AJ" & j & ",TODAY()<AK" & j & "),TODAY()=AJ" & j & ",TODAY()=AK" & j & "),AH" & j & "-AI" & j & ",AH" & j & ")"                             ' Selling Price
        WBD.Worksheets(SheetName).Range("M" & j).Formula = "=B" & j & "*I" & j & "+IF(J" & j & ">0,J" & j & ",0)+IF(K" & j & ">0,K" & j & ",0)"                                                                            ' Total Landed Cost
        WBD.Worksheets(SheetName).Range("N" & j).Formula = "=B" & j & "*L" & j                                                                                                                                             ' Total Selling Price
        WBD.Worksheets(SheetName).Range("O" & j).Formula = "=IFERROR((L" & j & "/I" & j & ")-1,0)"                                                                                                                         ' % Markup
        WBD.Worksheets(SheetName).Range("T" & j).Formula = "=AC" & j                                                                                                                                                       ' HQ Stock
        WBD.Worksheets(SheetName).Range("U" & j).Formula = "=INDEX(A1:DB" & j & "," & j & ",MATCH(J1,A9:DB9,0))"                                                                                                           ' Selected Store Stock
        WBD.Worksheets(SheetName).Range("V" & j).Formula = "=AD" & j                                                                                                                                                       ' Overall Stock
        WBD.Worksheets(SheetName).Range("Y" & j).Formula = "=B" & j & "*CT" & j                                                                                                                                           ' Total Item Weight
        WBD.Worksheets(SheetName).Range("Q" & j).Formula = "=IF(OR(AND(TODAY()>AJ" & j & ",TODAY()<AK" & j & "),TODAY()=AJ" & j & ",TODAY()=AK" & j & "),AH" & j & "-AI" & j & ",AH" & j & ")"                             ' List Price
        WBD.Worksheets(SheetName).Range("P" & j).value = "=IF(OR(AND(TODAY()>AJ" & j & ",TODAY()<AK" & j & "),TODAY()=AJ" & j & ",TODAY()=AK" & j & "),AK" & j & "," & Chr(34) & Chr(34) & ")"                             ' STR Expiry
        WBD.Worksheets(SheetName).Range("CZ" & j).Formula = "=MAX($CU" & j & ":$CW" & j & ")"                                                                                                                              ' Longest Side
        WBD.Worksheets(SheetName).Range("DA" & j).Formula = "=Min($CU" & j & ":$CW" & j & ")"                                                                                                                              ' Shortest Side
        WBD.Worksheets(SheetName).Range("CB" & j).Formula = "=2*(SUM($CU" & j & ":CW" & j & ")-$CZ" & j & ")+$CZ" & j                                                                                                      ' GIRTH
        WBD.Worksheets(SheetName).Range("DC" & j).Formula = "=IF(OR(AND(AND(CT" & j & ">31.75,OR(CT" & j & "<68.04,CT" & j & "=68.04))),AND(CZ" & j & ">121.92,OR(CZ" & j & "<272.32,CZ" & j & "=272.32))),B" & j & ",0)"  ' OverSize QTY
        WBD.Worksheets(SheetName).Range("DD" & j).Formula = "=IF(AND(DB" & j & ">330.2,OR(DB" & j & "=419.1, CB" & j & " <419.2)),B" & j & ",0)"                                                                           ' Large QTY
        WBD.Worksheets(SheetName).Range("DE" & j).Formula = "=IF(AND(CZ" & j & ">45.72,OR(DA" & j & "=5.08,DA" & j & "<5.08)),B" & j & ",0)"                                                                               ' Flat Package QTY"
        
        With WBD.Worksheets(SheetName).Range("F" & j)
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:="=F" & j & "= 0"
            .FormatConditions(.FormatConditions.count).SetFirstPriority
            .FormatConditions(1).Interior.Color = RGB(255, 255, 255)
            .FormatConditions(1).Font.Color = RGB(255, 255, 255)
            .FormatConditions(1).StopIfTrue = False
            .Locked = False
        End With
        With WBD.Worksheets(SheetName).Range("I" & j)
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:="=I" & j & "= 0"
            .FormatConditions(.FormatConditions.count).SetFirstPriority
            .FormatConditions(1).Interior.Color = RGB(217, 217, 217)
            .FormatConditions(1).Font.Color = RGB(217, 217, 217)
            .FormatConditions(1).StopIfTrue = False
            .Locked = True
        End With
        With WBD.Worksheets(SheetName).Range("L" & j)
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:="=L" & j & "= 0"
            .FormatConditions(.FormatConditions.count).SetFirstPriority
            .FormatConditions(1).Interior.Color = RGB(255, 255, 255)
            .FormatConditions(1).Font.Color = RGB(255, 255, 255)
            .FormatConditions(1).StopIfTrue = False
            .Locked = False
        End With
        With WBD.Worksheets(SheetName).Range("M" & j)
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:="=M" & j & "= 0"
            .FormatConditions(.FormatConditions.count).SetFirstPriority
            .FormatConditions(1).Interior.Color = RGB(217, 217, 217)
            .FormatConditions(1).Font.Color = RGB(217, 217, 217)
            .FormatConditions(1).StopIfTrue = False
            .Locked = True
        End With
        With WBD.Worksheets(SheetName).Range("N" & j)
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:="=N" & j & "= 0"
            .FormatConditions(.FormatConditions.count).SetFirstPriority
            .FormatConditions(1).Interior.Color = RGB(217, 217, 217)
            .FormatConditions(1).Font.Color = RGB(217, 217, 217)
            .FormatConditions(1).StopIfTrue = False
            .Locked = True
        End With
        With WBD.Worksheets(SheetName).Range("O" & j)
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:="=O" & j & "= 0"
            .FormatConditions(.FormatConditions.count).SetFirstPriority
            .FormatConditions(1).Interior.Color = RGB(217, 217, 217)
            .FormatConditions(1).Font.Color = RGB(217, 217, 217)
            .FormatConditions(1).StopIfTrue = False
            .Locked = True
        End With
        With WBD.Worksheets(SheetName).Range("Q" & j)
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:="=Q" & j & "= 0"
            .FormatConditions(.FormatConditions.count).SetFirstPriority
            .FormatConditions(1).Interior.Color = RGB(217, 217, 217)
            .FormatConditions(1).Font.Color = RGB(217, 217, 217)
            .FormatConditions(1).StopIfTrue = False
            .Locked = True
        End With
        With WBD.Worksheets(SheetName).Range("T" & j)
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:="=T" & j & "= 0"
            .FormatConditions(.FormatConditions.count).SetFirstPriority
            .FormatConditions(1).Interior.Color = RGB(255, 255, 255)
            .FormatConditions(1).Font.Color = RGB(255, 255, 255)
            .FormatConditions(1).StopIfTrue = False
            .Locked = True
        End With
    
        With WBD.Worksheets(SheetName).Range("V" & j)
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:="=V" & j & "= 0"
            .FormatConditions(.FormatConditions.count).SetFirstPriority
            .FormatConditions(1).Interior.Color = RGB(255, 255, 255)
            .FormatConditions(1).Font.Color = RGB(255, 255, 255)
            .FormatConditions(1).StopIfTrue = False
            .Locked = True
        End With
        
        With WBD.Worksheets(SheetName).Range("U" & j)
            .FormatConditions.Delete
            b = "=ISERROR(INDEX(A1:DB" & j & "," & j & ",MATCH(J1,A9:DB9,0))"
            .FormatConditions.Add Type:=xlErrorsCondition, Formula1:=b
            .FormatConditions(1).SetFirstPriority
            .FormatConditions(1).Font.Color = vbWhite
            .FormatConditions(1).Interior.Color = RGB(255, 255, 255)
            .FormatConditions(1).StopIfTrue = False
            .Locked = True
        End With
        
        With WBD.Worksheets(SheetName).Range("U" & j)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=U" & j & "= 0"
            .FormatConditions(2).Interior.Color = RGB(255, 255, 255)
            .FormatConditions(2).Font.Color = RGB(255, 255, 255)
            .FormatConditions(2).StopIfTrue = False
            .Locked = True
        End With
        
    Next j
    
    
    
    cnt = LBound(ar())
    
    ar(1) = 4.43
    ar(2) = 5
    ar(3) = 19
    ar(4) = 46.43
    ar(5) = 14.57
    ar(6) = 15.86
    ar(7) = 11.71
    ar(8) = 12.57
    ar(9) = 11.43
    ar(10) = 9.43
    ar(11) = 9.43
    ar(12) = 14
    ar(13) = 16.43
    ar(14) = 15.86
    ar(15) = 16.14
    ar(16) = 13.14
    ar(17) = 13.14
    ar(18) = 3.14
    ar(19) = 3.14
    ar(20) = 5
    ar(21) = 5
    ar(22) = 5
    
    For cnt = LBound(ar()) To UBound(ar())
        Columns(cnt).ColumnWidth = ar(cnt)
    Next cnt
    
    
    With Application
        'cancel any xlMaximized
        .WindowState = xlNormal
    
        .Top = 1 '< points
        .Left = 1 '< points
            
        '//WIDTH
        .Width = Application.UsableWidth
        '//HEIGHT
        .Height = 600
            
        With .ActiveWindow
            .WindowState = xlNormal
            .Top = 1 '< points
            .Left = 1 '< points
            'ZOOM
            'replace 800 with your screen width
            .Zoom = 91
        End With
    End With
    
    WBD.Worksheets(SheetName).Unprotect Password:=vbNullString
    WBD.Worksheets(SheetName).Range("F10:G" & QLastCalcRow & ",I10:N" & QLastCalcRow & ",Q10:Q" & QLastCalcRow & ",N6:Q6").NumberFormat = "$#,##0.00_);($#,##0.00)"
    WBD.Worksheets(SheetName).Range("R6,O10:O" & QLastCalcRow).NumberFormat = "0.00%"
    WBD.Worksheets(SheetName).Range("C8:D8").Font.Color = RGB(255, 255, 255)
    WBD.Worksheets(SheetName).Columns("W:DE").EntireColumn.Hidden = True
    WBD.Worksheets(SheetName).Range("D2:D7,C8,B10:H" & QLastCalcRow & ", P10:P" & QLastCalcRow & ",F4:I7,M2:M3,M6:M7,N6").Locked = False
    WBD.Worksheets(SheetName).Range("M10:O" & QLastCalcRow & ", Q10:Q" & QLastCalcRow).Locked = True
    WBD.Worksheets(SheetName).Range("R10:R" & QLastCalcRow).Interior.Color = RGB(255, 255, 204)
    WBD.Worksheets(SheetName).Range("I10:I" & QLastCalcRow & ",M10:O" & QLastCalcRow & ",Q10:Q" & QLastCalcRow).Interior.Color = RGB(217, 217, 217)
    WBD.Worksheets(SheetName).Range("R10:S" & QLastCalcRow).Font.Name = "Wingdings 2"
    WBD.Worksheets(SheetName).Range("A10:A" & QLastCalcRow & ",B10:B" & QLastCalcRow & ",E10:S" & QLastCalcRow).HorizontalAlignment = xlCenter
    WBD.Worksheets(SheetName).Range("C10:D" & QLastCalcRow).HorizontalAlignment = xlLeft
    WBD.Worksheets(SheetName).Range("D2").value = "None"
Next i

End Sub
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Sort by date Sort by votes
Oh. This is the code to add Sheet Change Code:

VBA Code: 
Public Sub AddWorksheetChangeCode()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim xLine As Long

FileName = "AnyNameWB.xlsm"
For i = 1 To 8
    SheetName = "Q" & i
    Workbooks(FileName & ".xlsm").Worksheets(SheetName).Activate
    Workbooks(FileName & ".xlsm").Worksheets(SheetName).Range("E10").Select
    ActiveWindow.Zoom = 91
    ActiveSheet.EnableOutlining = True
    ActiveSheet.Protect contents:=True, UserInterfaceOnly:=True
        
        Set VBProj = Workbooks(FileName & ".xlsm").VBProject
        Set VBComp = VBProj.VBComponents("Sheet" & i)
        Set CodeMod = VBComp.CodeModule
        
        With CodeMod
            xLine = .CreateEventProc("SelectionChange", "Worksheet")
            xLine = xLine + 1
            .InsertLines xLine, "  Dim LastRow, i, j, LastRowStock As Long"
            .InsertLines xLine + 1, "Dim SheetName, QuoteStockCol, ItemCode, StockReport As String"
            .InsertLines xLine + 3, "QLastCalcRow = LastCalcRow"
            .InsertLines xLine + 4, "'Protect UserInterfaceOnly:=True"
            .InsertLines xLine + 5, "SheetName = ActiveSheet.Name"
            .InsertLines xLine + 6, "ThisWorkbook.Worksheets(SheetName).Unprotect Password:=vbNullString"
            .InsertLines xLine + 7, "    CurrentRow = ActiveCell.Row"
            .InsertLines xLine + 8, "    Application.EnableEvents = True"
            .InsertLines xLine + 9, "    If Target.CountLarge > 1 Then Exit Sub"
            .InsertLines xLine + 10, "        If Not Intersect(Target, Range(" & Chr(34) & "U10:V" & Chr(34) & " & QLastCalcRow)) Is Nothing Then"
            .InsertLines xLine + 11, "            Me.Unprotect"
            .InsertLines xLine + 12, "            Application.EnableEvents = False"
            .InsertLines xLine + 13, "            ItemCode = ActiveSheet.Range(" & Chr(34) & "E" & Chr(34) & " & CurrentRow)"
            .InsertLines xLine + 14, "             'InventoryList.Show"
            .InsertLines xLine + 15, "            Application.EnableEvents = True"
            .InsertLines xLine + 16, "            Me.Protect"
            .InsertLines xLine + 17, "            Application.EnableEvents = True"
            .InsertLines xLine + 18, "        End If"
            .InsertLines xLine + 19, "   If Not Intersect(Target, Range(" & Chr(34) & "R10:R" & Chr(34) & " & QLastCalcRow)) Is Nothing Then"
            .InsertLines xLine + 20, "      Me.Unprotect"
            .InsertLines xLine + 21, "      Application.EnableEvents = False"
            .InsertLines xLine + 22, "      Target.value = IIf(Target.value = vbNullString, " & Chr(34) & "P" & Chr(34) & ", vbNullString)"
            .InsertLines xLine + 23, "      Application.EnableEvents = True"
            .InsertLines xLine + 24, "      Me.Protect"
            .InsertLines xLine + 25, "      Application.EnableEvents = True"
            .InsertLines xLine + 26, "    End If"
            .InsertLines xLine + 27, "    On Error Resume Next"
            .InsertLines xLine + 28, "    If Not Intersect(Target, Range(" & Chr(34) & "S10:S" & Chr(34) & " & QLastCalcRow)) Is Nothing Then"
            .InsertLines xLine + 29, "      Me.Unprotect"
            .InsertLines xLine + 30, "      Application.EnableEvents = False"
            .InsertLines xLine + 31, "      Target.value = IIf(Target.value = vbNullString, " & Chr(34) & "R" & Chr(34) & ", vbNullString)"
            .InsertLines xLine + 32, "      Application.EnableEvents = True"
            .InsertLines xLine + 33, "      Me.Protect"
            .InsertLines xLine + 34, "      Application.EnableEvents = True"
            .InsertLines xLine + 35, "    End If"
            .InsertLines xLine + 36, "    If Not Intersect(Target, Range(" & Chr(34) & "E10:E" & Chr(34) & " & QLastCalcRow)) Is Nothing Then"
            .InsertLines xLine + 37, "      Me.Unprotect"
            .InsertLines xLine + 38, "      CurrentRow = ActiveCell.Row"
            .InsertLines xLine + 39, "      ThisWorkbook.Worksheets(SheetName).Range(" & Chr(34) & "E" & Chr(34) & " & CurrentRow).value = Replace(ThisWorkbook.Worksheets(SheetName).Range(" & Chr(34) & "E" & Chr(34) & " & CurrentRow).value, " & Chr(34) & " " & Chr(34) & ", vbNullString)"
            .InsertLines xLine + 40, "      ThisWorkbook.Worksheets(SheetName).Range(" & Chr(34) & "E" & Chr(34) & " & CurrentRow).value = Replace(ThisWorkbook.Worksheets(SheetName).Range(" & Chr(34) & "E" & Chr(34) & " & CurrentRow).value, vbLf, vbNullString)"
            .InsertLines xLine + 41, "    End If"
            .InsertLines xLine + 42, "  Application.EnableEvents = True"
            .InsertLines xLine + 43, "With ThisWorkbook.Worksheets(SheetName).Range(" & Chr(34) & "R10:S" & Chr(34) & " & QLastCalcRow)"
            .InsertLines xLine + 44, "            With .Font"
            .InsertLines xLine + 45, "                .Name = " & Chr(34) & "Wingdings 2" & Chr(34)
            .InsertLines xLine + 46, "                .FontStyle =" & Chr(34) & "Regular" & Chr(34)
            .InsertLines xLine + 47, "                .Size = 13"
            .InsertLines xLine + 48, "            End With"
            .InsertLines xLine + 49, "End With"
            .InsertLines xLine + 50, "ThisWorkbook.Worksheets(SheetName).Range(" & Chr(34) & "D2" & Chr(34) & ").Locked = False"
            .InsertLines xLine + 51, "ThisWorkbook.Worksheets(SheetName).Protect Password:=vbNullString"
            .InsertLines xLine + 52, "Application.EnableEvents = True"
            .InsertLines xLine + 53, "Application.Calculation = xlAutomatic"
        End With
Next i




TurnOnFunctionality

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
Help Cleaning Up / Optimizing VBA Code
Replies
6
Views
545
offthelip
O
M
  • Question Question
Copied sheet code to new file and lost some functionality....not sure how/why
Replies
5
Views
124
MeaclH
M
C
  • Question Question
Runtime Error only on some sheets - Macro reference "Active Sheet"
Replies
5
Views
569
RoryA
RoryA
K
  • Question Question
Comparing two sheets
Replies
3
Views
1K
Killragtshirts
K
W
  • Solved
Runtime Error 5 on very complicated sheet (to me anyway :) )
2 3
Replies
26
Views
3K
Woodpusher147
W

Forum statistics

Threads
1,224,811
Messages
6,181,082
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top