Private Sub Submit_Click()
Application.ScreenUpdating = False
Dim rangeForCode As range, rngLookupRange As range
Dim row As Integer, stock As Integer
Dim result As Integer
Dim drugCodePC As Integer
Dim qty As Integer
Dim ws As Worksheet
drugCodePC = CInt(DrugCode2.Value)
qty = CInt(Quantity.Value)
'Populating the drug name
Set ws = Worksheets("Drug Record")
ws.Select
*Set rangeForCode = ws.range("DrugCodeInventory")*
row = Application.WorksheetFunction.Match(drugCodePC, rangeForCode, 1)
Set rngLookupRange = ws.range("Inventory")
stock = Application.WorksheetFunction.VLookup(drugCodePC, rngLookupRange, 3, False)
result = stock + qty
'MsgBox (row)
ws.Cells(row + 1, 3).Value = result
Application.ScreenUpdating = True
Unload PurchaseForm
End Sub
This keeps throwing the error "method range of object _worksheet failed named range".
The error occurs at the **. I know it has something to do with the named ranged because previously, when i wrote the range of cells ie. "A1:A215" it works. I've checked the name range and it looks right. The name of the named ranged is also correct. I've tried to activate the workbook first but the error is still thrown.
The named ranged is:
= OFFSET(DrugCodeInventory!$A$2, 0, 0, COUNTA(DrugCodeInventory!$A:$A)-1,1)
I only want to select the first column in my worksheet dynamically.
If you run this in the Immediate window does it work?
application.Goto Worksheets("Drug Record").range("DrugCodeInventory")
If it doesn't run then try deleting the named range and creating a new one.
Please also try explicitly qualifying this section of your code:
Dim ws As Excel.Worksheet '<added full qualification here
drugCodePC = CInt(DrugCode2.Value)
qty = CInt(Quantity.Value)
'Populating the drug name
Set ws = Excel.thisworkbook.Worksheets("Drug Record") '<added full qualification here
ws.Select
*Set rangeForCode = ws.range("DrugCodeInventory")*
Kindly use the below isNameRngExist function which will return true when the name range "DrugCodeInventory" exist and then you can proceed with further manipulation.
Function isNameRngExist(myRng As String) As Boolean
On Error Resume Next
isNameRngExist = Len(ThisWorkbook.Names(TheName).Name) <> 0
End Function
Related
I have an issue with my VBA script which I'm not able to resolve, despite of all the researches I've made (Indeed, I tried to modify all the vba scripts which were near what I'm looking for, but it doesn't work).
Thank you very much for your help !
I have 2 sheets.
For the first one (ActiveSheet), I have a list.
For example :
Beurre
Creme fraiche
Fromage
Oeufs
Yaourts
In the second one ("Add value"), I have this list :
Chocolat
Carotte
Haricot
Fromage
Endive
I want the script to verify if the first value which is the sheet ("Add Value") exists in the ActiveSheet.
If it doesn't, it takes the second value in "Add Value" to make this verification. And so on with the other lines.
The loop has to stop when the script finds the same value. Then it does an action (MsgBox, for example).
For example, when the script researches "Chocolat" (the first line of the sheet "Add Value") in the ActiveSheet, it won't find it : it will use the second word to make this reasearch until it uses world "Fromage" which also exist in the second sheet.
It does the action (the msgbox), then quit the loop to continue with the other called macro which are in the script.
Moreover, I would like to choose the columns of the cell from "Add Value" each time I call the macro. Indeed, there will be several lists in this sheet.
Here is my macro. The issue is that I get the error 424 on the ligne If Not FindString Is Nothing Then
Public Sub Var()
Dim plage As Variant
Set plage = ActiveSheet.Range("A:A")
Dim col As Integer
Dim Ligne As Integer
Set Ligne = 2
Dim FindString As String
Set FindString = ThisWorkbook.Sheets("Add Value").Cells(Ligne, col).Value
End Sub
Sub Boucle_Ajout(col)
With plage
Do
If Not FindString Is Nothing Then
'do
Else
Ligne = Ligne + 1
End If
Loop While Not FindString Is Nothing
End With
End Sub
Then when I call the Macro, I only have to choose the column.
For example :
Call Boucle_Ajout(1)
Thank you very much for your help, because I am sick of not finding the solution.
PS : sorry for my english, I'm french.
Assuming the lines without numbers are in A1 to A5, this works:
Option Explicit
Const THECOLUMN = "A1"
Sub FindLineInOtherSheet()
Dim activeSheetRange As Range
Dim addValueRange As Range
Dim activeSheetLastRow As Integer
Dim addValueLastRow As Integer
Dim i As Integer
Dim n As Integer
Dim activeSheetCell As String
Dim addValueCell As String
'*
'* Setup
'*
Set activeSheetRange = ThisWorkbook.Sheets("activeSheet").Range(THECOLUMN)
activeSheetLastRow = findLastRow("activeSheet", THECOLUMN)
addValueLastRow = findLastRow("addValue", THECOLUMN)
'*
'* Loop through each cell in addValue for each cell in activeSheet
'*
For i = 1 To activeSheetLastRow
Set addValueRange = ThisWorkbook.Sheets("addValue").Range(THECOLUMN)
activeSheetCell = activeSheetRange.Value
For n = 1 To addValueLastRow
addValueCell = addValueRange.Value
If addValueCell = activeSheetCell Then
MsgBox ("Trouvé " & addValueCell)
End If
Set addValueRange = addValueRange.Offset(1, 0) 'Next row
Next n
Set activeSheetRange = activeSheetRange.Offset(1, 0)
Next i
End Sub
Function findLastRow(Sheetname As String, ColumnName As String) As Integer
Dim lastRow As Integer
Dim r As Range
Dim WS As Worksheet
Set WS = Worksheets(Sheetname)
lastRow = WS.UsedRange.Rows.Count
'*
'* Search backwards till we find a cell that is not empty
'*
Set r = WS.Range(ColumnName).Rows(lastRow)
While IsEmpty(r)
Set r = r.Offset(-1, 0)
Wend
lastRow = r.Row
Set WS = Nothing
findLastRow = lastRow
End Function
With below code I am calculating the RSS. It does however happen that the Y range does not actually contain values. I have surpassed the error (Run-time error '1004') that displays when there aren't any values with 'on error goto next' but then it just 'copies' the same value as the previous one in the destination cell when there wouldn't actually be any.
Is there a way to display "NA" in stead of the previous value in the destination cell where the RSS cannot be calculated due to a lack of Y values?
Thank you in advance
Private Sub Regr(strWksData As String, WsTools As Worksheet, strWksFF3 As String, strWksResult As String)
Dim NoOfRow As Long
Dim i As Integer
Dim sData As Worksheet
Dim sFF3 As Worksheet
Dim sResult As Worksheet
Dim rX1 As Range
Dim rY1 As Range
'General
Set sData = Sheets("Return")
Set sFF3 = Sheets("FF-3")
Set sResult = Sheets("Result")
'Set X ranges
Set rX1 = sFF3.Range("C2:E21")
'Set Y ranges
Set rY1 = sData.Range("F2:F21")
'Loop through columns
'Provide statistic
On Error GoTo ErrorHandling
For i = 0 To 5
vStat1 = Application.WorksheetFunction.LinEst(rY1.Offset(0, i), rX1, True, True)
sResult.Range("F2").Offset(0, i).Value = vStat1(5, 2)
NoOfRow = rY1.Rows.Count
WsTools.Range("B2").Value = NoOfRow
Next i
ErrorHandling:
Resume Next
On Error GoTo 0
MsgBox ("RSS Done")
End Sub
Since you are writing the results directly to the worksheet, just take advantage of the different error reporting behavior of Application.LinEst v. Application.WorksheetFunction.LinEst.
When you call the fully qualified WorksheetFunction, any error raised in the called function is thrown as a run-time error:
Debug.Print Application.WorksheetFunction.Sum("a", "b") '<--runtime error 1004
When you use the extensible interface on Application, any error raised in the called function is returned wrapped in a Variant:
Debug.Print Application.Sum("a", "b") '<--Prints Error 2015 (#VALUE!)
If you need to test to see whether or not it's an error, you can use the IsError function:
Dim v As Variant
v = Application.Sum("a", "b")
Debug.Print IsError(v) '<-- True
In your case, you can just write the error value directly to the cell:
For i = 0 To 5
Dim result As Variant
result = Application.LinEst(rY1.Offset(0, i), rX1, True, True)
'Don't attempt to use the indexer on an error.
If IsError(result) Then
sResult.Range("F2").Offset(0, i).Value = result
Else
sResult.Range("F2").Offset(0, i).Value = result(5, 2)
End If
Next
I am trying to add some automation to a spreadsheet by changing the value of cells in one column based on the value in that column and one other. I have got the code below so far. If I use .text the code runs through fine but makes no changes to the values of the cells. If I use .value I get this error message:
Run-time error '13: Type mismatch
Please could someone advise on what I am doing wrong here.
Sub change_orrtime_4()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'For Each employee In Range("Timesheet_RawData[Employee]")
Dim employee As Range
Dim datefield As Range
Dim tbl As ListObject
Dim tRows As Long
Dim tCols As Long
Dim i As Long
Set tbl = Sheets("Timesheet Data").ListObjects("Timesheet_RawData")
With tbl.DataBodyRange
tRows = .Rows.Count
' tCols = .Colummns.Count
End With
With Sheets("Timesheet Data")
Set employee = Sheets("Timesheet Data").Range("Timesheet_RawData[Employee]")
Set datefield = Sheets("Timesheet Data").Range("Timesheet_RawData[Date]")
End With
With Sheets("Timesheet Data")
For i = 2 To tRows
If employee.Value = "Some Name" And datefield.Value = "1" Then ' type mismatch doesnt occur with .text but then nothing works
employee.Value = "Some Name_SomeTeam"
End If
Next i
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
you're setting employee (and datefield, too) to multiple cells ranges, therefore you can't access it Value property, while you can access it Text property that would return a text if all cells share that same text or otherwise a Null
so you have to point at the specific cell in that range, like:
employee(i).Value
finally you could refactor your code a little as follows:
Sub change_orrtime_4()
Dim employee As Range
Dim datefield As Range
Dim tRows As Long
Dim tCols As Long
Dim i As Long
With Sheets("Timesheet Data")
With .ListObjects("Timesheet_RawData")
With .DataBodyRange
tRows = .Rows.Count
' tCols = .Colummns.Count
End With
Set employee = .ListColumns("Employee").DataBodyRange
Set datefield = .ListColumns("Date").DataBodyRange
End With
For i = 1 To tRows
If employee(i).Value = "Some Name" And datefield(i).Value = "1" Then employee(i).Value = "Some Name_SomeTeam"
Next i
End With
End Sub
I'm trying to copy named ranges from the Wk1 worksheet to the active sheet in the workbook.
I keep getting error messages when I run the code. They either say an Object is not set or a variable has not been declared.
Sub ChangeNamedRangesOnNewWKsheet()
Dim RangeName As Name
Dim HighlightRange As Range
Dim RangeName2 As String
Dim NewRangeName As String
Dim Ws As Worksheets
Dim cs As Worksheet
Set cs = Application.ActiveSheet
''''' Delete invalid named ranges
For Each RangeName In ActiveWorkbook.Names
If InStr(1, RangeName.RefersTo, "#REF!") > 0 Then
RangeName.Delete
End If
Next RangeName
For Each RangeName In Ws
If InStr(1, RangeName, "Wk1", 1) > 0 Then
Set HighlightRange = RangeName.RefersToRange
NewRangeName = Replace(RangeName.Name, "Wk1", "cs.Name")
RangeName2 = Replace(RangeName, "='Wk1'", "'cs.Name'")
On Error Resume Next
HighlightRange.Copy Destination:=Worksheets("cs.Name").Range(RangeName2)
Range(RangeName2).Name = NewRangeName
On Error GoTo 0
End If
Next RangeName
MsgBox "Done"
End Sub
Ive changed the code to this. Im not getting error messages but the code is still not working. the named ranges are not copying from the Wk1 sheet to the Active sheet. The only thing that happens is that the Message Box Opens
Sub ChangeNamedRangesOnNewWKsheet()
Dim RangeName As Name
Dim HighlightRange As Range
Dim RangeName2 As String
Dim NewRangeName As String
Dim Cs As Worksheet
Set Cs = Application.ActiveSheet
''''' Delete invalid named ranges
For Each RangeName In ActiveWorkbook.Names
If InStr(1, RangeName.RefersTo, "#REF!") > 0 Then
RangeName.Delete
End If
Next RangeName
For Each RangeName In ActiveWorkbook.Names
If InStr(1, RangeName, "Wk1", 1) > 0 Then
Set HighlightRange = RangeName.RefersToRange
NewRangeName = Replace(RangeName.Name, "Wk1", "cs.Name")
RangeName2 = Replace(RangeName, "='Wk1'", "'cs.Name'")
On Error Resume Next
HighlightRange.Copy Destination:=Worksheets("cs.Name").Range(RangeName2)
Range(RangeName2).Name = NewRangeName
On Error GoTo 0
End If
Next RangeName
MsgBox "Done"
End Sub
Took me some time to figure out whats not working when there is no error, but finally I think I managed to figure out the issue.
Replace the following line in your code
HighlightRange.Copy Destination:=Worksheets("cs.Name").Range(RangeName2)
to:
HighlightRange.Copy Destination:=Worksheets(cs.Name).Range(HighlightRange.Address)
This should give you desired result.
Syntax for Copy to destination is Destination:=Worksheets("sheet_name").Range(range). Here sheet_name should be the name of the sheet. So when you write Worksheets("cs.Name") code looks for the sheet named cs.Name which actually does not exist hence just use Worksheets(cs.Name). Second thing here is range (just to explain things better I am using $A$1:$A$5 as range). When you write .Range(RangeName2) code is looking for 'cs.Name'!$A$1:$A$5. Again this is incorrect because range should be written as .Range($A$1:$A$5). So .Range(HighlightRange.Address) will give you the proper range.
You can also play out in the line RangeName2 = Replace(RangeName, "='Wk1'", "'cs.Name'") to get proper address.
Hope this helps.
EDIT :
__________________________________________________________________________________
example of what i want. copy the named range Wk1Totalhrs from Wk1 sheet to Wk2-Wk7 sheets so that Wk1Totalhrs becomes Wk2Totalhrs,Wk3Totalhrs etc on the corresponding new sheet
Try the following code to achieve what you mentioned as your requirement in comment (or as above).
Sub ChangeNamedRangesOnNewWKsheet()
Dim RangeName As Name
Dim HighlightRange As Range
Dim RangeName2 As String, NewRangeName As String, SearchRange As String
Dim MyWrkSht As Worksheet, cs As Worksheet
Set MyWrkSht = ActiveWorkbook.Worksheets("Wk1")
SearchRange = "Wk1Totalhrs" '---> enter name of the range to be copied
''''' Delete invalid named ranges
For Each RangeName In MyWrkSht.Names
If InStr(1, RangeName.RefersTo, "#REF!") > 0 Then
RangeName.Delete
End If
Next RangeName
'For Each RangeName In MyWrkSht.Names ActiveWorkbook.Names
For Each RangeName In ActiveWorkbook.Names
If RangeName.Name = SearchRange Then '---> search for the named range Wk1Totalhrs
Set HighlightRange = RangeName.RefersToRange
For Each cs In ActiveWorkbook.Sheets
Debug.Print cs.Name
If cs.Name <> "Wk1" Then '---> don't do anything in the sheet Wk1
NewRangeName = Replace(RangeName.Name, "Wk1", cs.Name)
RangeName2 = Replace(RangeName, "='Wk1'", cs.Name)
HighlightRange.Copy Destination:=Worksheets(cs.Name).Range(HighlightRange.Address)
Range(RangeName2).Name = NewRangeName
End If
Next cs
End If
Next RangeName
End Sub
I think it's just as simple as this.
Public Sub ShowNames()
Dim Nm As Name
Dim i As Long
For Each Nm In ActiveWorkbook.Names
i = i + 1
Range("A1").Offset(i, 0).Value = Nm
Next Nm
End Sub
Im not getting error messages but the code is still not working.the named ranges are not copying from the Wk1 sheet to the Active sheet.
The following line will return false positives when the named range starts with or contains WK10, WK11, etc.
If InStr(1, RangeName, "Wk1", 1) > 0 Then
A little further down, you are quoting a variable property; this makes it a literal string, not the value of the variable property.
NewRangeName = Replace(RangeName.Name, "Wk1", "cs.Name")
You need a more concrete way to identify the defined names on WK1. After looking closely at your problem, I believe that you may have one or more dynamic named ranges that are defined by formulas. This would explain some of the 'not working' behavior of your code that should be working with more conventional ReferTo: properties.
There is also the problem of whether you should rewrite the RefersTo: of an existing defined named range or add a new named range. One common practise is to simply attempt to delete the named range un On Error Resume Next and then create a new one. I've never liked this method for a variety of reasons; one being that deleting a named range will make dependent named ranges refer to #REF! and I've never considered on error resume next to be a 'best practise'.
The following builds a dictionary of keys containing named ranges to be created and ones that already exist using multiple criteria. I've tested this repeatedly on a combination of conventional and dynamic named ranges with success.
Option Explicit
Sub ChangeNamedRangesOnNewWKsheet()
Dim nm As Name
Dim rtr As String, nm2 As String
Dim w As Long
Dim k As Variant, dict As Object
Set dict = CreateObject("Scripting.Dictionary")
dict.comparemode = vbTextCompare
With ActiveWorkbook
'Delete invalid named ranges and build dictionary of valid ones from WK1
For Each nm In .Names
If CBool(InStr(1, nm.RefersTo, "#REF!", vbTextCompare)) Or _
CBool(InStr(1, nm.RefersTo, "#NAME?", vbTextCompare)) Then
'Debug.Print nm.Name
On Error Resume Next
nm.Delete
Err.Clear
On Error GoTo 0
ElseIf LCase(Left(nm.Name, 3)) = "wk1" And _
(CBool(InStr(1, nm.RefersTo, "wk1!", vbTextCompare)) Or _
CBool(InStr(1, nm.RefersTo, "'wk1'!", vbTextCompare))) Then
dict.Item(Mid(nm.Name, 4)) = LCase(nm.RefersTo)
ElseIf LCase(Left(nm.Name, 2)) = "wk" Then
dict.Item(nm.Name) = LCase(nm.RefersTo)
End If
Next nm
For w = 1 To Worksheets.Count
With Worksheets(w)
If LCase(.Name) <> "wk1" And Left(LCase(.Name), 2) = "wk" Then
For Each k In dict
If dict.exists(.Name & k) Then
.Parent.Names(.Name & k).RefersTo = _
Replace(LCase(dict.Item(k)), "wk1", .Name, 1, -1, vbTextCompare)
ElseIf Left(LCase(k), 2) <> "wk" Then
.Parent.Names.Add _
Name:=.Name & k, _
RefersTo:=Replace(LCase(dict.Item(k)), "wk1", .Name, 1, -1, vbTextCompare)
End If
Next k
End If
End With
Next w
End With
dict.RemoveAll: Set dict = Nothing
'MsgBox "All worksheets done"
End Sub
Note that this creates/redefines all named ranges on all worksheets (other than WK1). As far as I can determine, the only chance to have false positives would be to have an existing named range with a name something like WK1wkrange (but that would just be silly).
This code works
Public Sub CopyNamedRanges()
Dim namedRange As Name
Dim targetRefersTo As String
Dim targetName As String
On Error Resume Next
For Each namedRange In ActiveWorkbook.Names
If Left$(namedRange.RefersTo, 6) = "='Wk1'" And Left$(namedRange.Name, 3) = "Wk1" Then
targetName = Replace(namedRange.Name, "Wk1", ActiveSheet.Name)
targetRefersTo = Replace(namedRange.RefersTo, "Wk1", ActiveSheet.Name)
ActiveWorkbook.Names.Add targetName, targetRefersTo ' Might error if it already exists
ActiveWorkbook.Names(targetName).RefersTo = targetRefersTo
namedRange.RefersToRange.Copy Range(targetName) ' Remove this line if it's not required
End If
Next
End Sub
How the code works
This part If Left$(namedRange.RefersTo, 6) = "='Wk1'"
makes sure that the range refers to some cells on the sheet called Wk1
The other condition (Left$(namedRange.Name, 3) = "Wk1") would also match named ranges on sheets Wk10 - Wk19.
This part ActiveWorkbook.Names.Add targetName, targetRefersTo will adds a new named range that refers to the cells on the current sheet
This part namedRange.RefersToRange.Copy Range(targetName) copies the contents of the named range on the Wk1 sheet to the current sheet (remove the line if you don't need it)
Dim RangeName As Variant Try changing the variable type
I have a named range lstVendors that refers to: =OFFSET(Data!$W$2,0,0,COUNTA(Data!$W$2:$W$400),1). I want this range to be populated when the workbook opens. I have the following code for this:
Private Sub Workbook_Open()
Application.WindowState = xlMaximized
Dim rslt()
Dim i As Integer
Dim n As Integer
Dim startRng As Range
Dim DropDown1 As DropDown
ThisWorkbook.Sheets("Dashboard").Shapes("TextBox 6").Visible = False
' Range("lstVendors").Offset(0, 0).Value = "Please Select..."
' Set DropDown1 = ThisWorkbook.Sheets("Dashboard").DropDowns("Drop Down 1")
' DropDown1.Value = 1
On Error Resume Next
If Not IsError(Range("lstVendors")) Then
Range("lstVendors").ClearContents
End If
On Error GoTo 0
rslt = Application.Run("SQLite_Query", "path/to/my/sqlite", "SELECT PROGRAM_ID FROM VENDOR;")
Set startRng = Range("lstVendors")
i = 0
For n = 2 To UBound(rslt)
Range("lstVendors").Offset(i, 0).Value = rslt(n)(0)
i = i + 1
Next n
End Sub
It errors on the Set startRng = Range("lstVendors"). I know this is because there's nothing in the range when I'm trying to set it, because if I put one entry into the named range, the set works, however, I need it populated by the sqlite query on each open as the data changes.
Any suggestions much appreciated.
Try this. You have a dynamic range that doesn't evaluate after you clear the contents. To avoid this, there are probably several ways, but easy to simply hardcode the startRange variable so that it always points to Data!$W$2 address, which is (or rather, will become) the first cell in your lstVendors range.
Private Sub Workbook_Open()
Dim rslt()
Dim i As Integer
Dim n As Integer
Dim startRng As Range
Dim DropDown1 As DropDown
Dim rngList As Range
'// Define your startRange -- always will be the first cell in your named range "lstVendors"
' hardcode the address because the dynamic range may not evalaute.
Set startRange = Sheets("Data").Range("W2")
'// Empty th lstVendors range if it exists/filled
On Error Resume Next
Range("lstVendors").Clear
On Error GoTo 0
'// Run your SQL query
rslt = Application.Run("SQLite_Query", "path/to/my/sqlite", "SELECT PROGRAM_ID FROM VENDOR;")
i = 0
'// Print results to the Worksheet, beginning in the startRange cell
For n = 2 To UBound(rslt)
'Increment from the startRange cell
startRange.Offset(i, 0).Value = rslt(n)(0)
i = i + 1
'Verify that "lstVendors" is being populated
Debug.Print Range("lstVendors").Address
Next n
End Sub
Thanks for the suggestions. Here is what I ended up doing in order to get around my problem. It involves adding something I didn't specify would be ok in my original question, so David's answer is great if what I did isn't an option. I first populated the first two cells in my named range with "Please Select..." and "All". In Sub Workbook_Open() we do this:
Private Sub Workbook_Open()
Application.WindowState = xlMaximized
Dim rslt()
Dim i As Integer
Dim n As Integer
Dim startRng As Range
Dim DropDown1 As DropDown
' Disable our not found message
ThisWorkbook.Sheets("Dashboard").Shapes("TextBox 6").Visible = False
' Set our start range to our named range
Set startRng = Range("lstVendors")
' Grab all vendor names
rslt = Application.Run("SQLite_Query", "path/to/my/sqlite", "SELECT PROGRAM_ID FROM VENDOR;")
' Print result. Skip first two rows as constants "Please Select..." and "All" are populated there
i = 2
For n = 2 To UBound(rslt)
startRng.Offset(i, 0).Value = rslt(n)(0)
i = i + 1
Next n
End Sub
Then we will create Sub Workbook_BeforeClose:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' Disable the save changes dialog. This workbook will be locked up for display only. No need to confuse the user.
Application.DisplayAlerts = False
' Clear everything below the "Please Select..." and "All" cells in the named range
On Error Resume Next
Range("lstVendors").Offset(2, 0).ClearContents
On Error GoTo 0
' Save the changes to the named range
ThisWorkbook.Save
Application.DisplayAlerts = True
End Sub
This information is going to populate a drop down, so having Please Select and All hardcoded into the named range is acceptable for me. If that stipulation doesn't work for someone else looking at this in the future, please use David's suggestion! Thanks again!