Updating ActiveWorkbook.Names("X").RefersTo and Names.Value in VBA - vba

Question

I have some code that currently looks through the sheet for any cell that I have filled with a light grey, and then adds the value within that cell to a Names list. The goal being that somewhere else in the workbook I can reference this list as a drop down.
Here's my current code:
Sub Add_Food_To_List()
i = 1
Application.ScreenUpdating = False
Range("a1:a60").Select
x = "{"
y = ""
first = True
For Each Cell In Selection
If ActiveCell.Interior.ColorIndex = "2" Then
i = i + 1
If first = False Then
x = x & ", " & ActiveCell.Value
y = y & ", " & ActiveCell.Address
End If
If first Then
x = x & ActiveCell.Value
y = y & ActiveCell.Address
first = False
End If
ActiveWorkbook.Names("Foods").RefersTo = y
ActiveWorkbook.Names("Foods").Value = x
End If
ActiveCell.Offset(1, 0).Select
Next Cell
Range("a1").Select
Application.ScreenUpdating = True
End Sub
For some reason these two lines within the For Each Cell In Selection:
ActiveWorkbook.Names("Foods").RefersTo = y
ActiveWorkbook.Names("Foods").Value = x
overwrite each other. Whichever goes last ends up as the value that both RefersTo AND Value are set to in the name.
Bonus: This is my first VBA script. How can I get this script to run on the entire workbook, not just the active sheet? Also, how do I make it run automatically on save, or on workbook update?

Answer 1

Perhaps this will serve you better:
Create a Worksheet in your Workbook with the name Reference.
Type Foods in cell A1 and put at least one random food in cell A2.
Create a defined name of Foods with the following formula: =offset(A2,0,0,counta(A:A)-1,1) This is a Dynamic Named Ranges that will expand or contract as rows are added or deleted (just be sure there are no blank rows in between data).
Place the below code in the ThisWorkbook module in the VBE. The below code will run right before the Workbook saves. It will loop through each sheet and add the values of any cells highlighted grey in Range(A1:A60) to the rowset in column A of the Reference Worksheet directly underneath the existing rowset.
Code for Module:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Reference" Then
With ws
Dim rCell As Range
For Each rCell In .Range("a1:a60")
If rCell.Interior.ColorIndex = "2" Then
Dim wsRef As Worksheet
Set wsRef = Sheets("Reference")
If wsRef.Range("Foods").Find(rCell.Value, lookat:=xlWhole) Is Nothing Then
wsRef.Range("A" & wsRef.Rows.Count).End(xlUp).Offset(1).Value = rCell.Value2
End If
End If
Next
End With
End If
Application.ScreenUpdating = True
End Sub