Look up function vba?

[Marsau]

Hi There All. Newby here and would like some help from all the excell pros on this site for a project of mine.
I have Calendar in one spread sheet that also shows menu no's.
In the next spread sheet i have a shopping list.
Would like to look up the menu no at the dates and link it to the shopping list base on the month chosen on the shopping list. Menu no's to update in (d8:ah8)
Secondly i woould like to blank out days if not appropiate for the month (d6:ah6)

[Leith Ross]

Hello Marsau,

Are the numbers on the Calendar in bold black font the menu numbers?

[Marsau]

hi there
Thank you for response
Menu numbers are in bold. not completed still need to populate the rest of the months. as you see it is 28 menus that repeat itself

[Kenneth Hobs]

Welcome to the forum!

Leith will probably come up with a better solution.

As usual, practice on a backup copy. Put this into a Module.

Sub FillMenus()
Dim rC As Range, rSLd As Range, aSLd
Dim i As Integer, j As Integer, d As Double, s As String
Dim ws As Worksheet, ws2 As Worksheet
Dim f As Range, c As Range, v, aa(1 To 31)

Set ws = Worksheets("Year Planner")
Set rC = ws.[A9:W56]
Set ws2 = Worksheets("SHOPPING LIST")

With ws2
Set rSLd = .[D6:AH6]
aSLd = WorksheetFunction.Transpose(rSLd)

'Array a with Dates for Shopping List day numbers.
For i = 1 To 31
s = .[C2] 'needed due to merge cell issue
d = Month(DateValue("01-" & s & "-1900"))
d = DateSerial(.[E2], d, aSLd(i, 1))
aSLd(i, 1) = d
Next i


'Find the month/year in ws, use cell interation due to merged cells.
For Each c In ws.Range("A7, I7,Q8,A20,I20,Q20,A33, I33, Q33, A46, I46, Q46")
If c = aSLd(1, 1) Then
Set f = c
Exit For
End If
Next c

On Error Resume Next
Set f = f.Offset(3).Resize(11, 7) 'Month block on ws
For i = 1 To f.Rows.Count Step 2 'menu rows
Set c = f.Rows(i)
For j = 1 To 7
v = Day(c.Cells(j).Offset(-1)) 'day number on ws
If v >= 1 And v <= 31 Then
d = CInt(c.Cells(j))
If d <> 0 Then aa(v) = d
End If
Next j
Next i

rSLd.Offset(2) = aa
'MsgBox Join(aa, vbCrLf)
End With
End Sub




To make it run by changing the month or year or sheet 2, right click the sheet's tab, view code, and paste:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect([C2,E2], Target)
If r Is Nothing Then Exit Sub
FillMenus
End Sub

Clearing the menu items on sheet 1 should be easy enough. If you get stuck, post back.

[Marsau]

Thank you so much
I do have an error though
I will ad file
Maybe it was just me pasting it in wrong places
Thanks for help once again
It gives me an error on fill menus
and doesnt update if i change the month on dropdown in the shopping List tab

[Marsau]

Correction I some how solved all of the above problems
Thanks for the great help

[Kenneth Hobs]

You forgot to insert a module and put FillMenus() in it. I did it for #5 file. Modules can have Public subs that can be called from any Private object like the worksheet.

If you ever need more than 31 menus, I would recommend changing those calendar rows to General format. I know it was probably set that way for a drag in fill by date formula. The code would need a tweak then too. I also recommend that setting for the Shopping List menu row. e.g. 25.00 numeric 2 decimal place may not be as-clear-as 25 general.

It is a smart yearly calendar.

[Marsau]

thank you so much Kenneth
if i select March it doesnt work though

[Marsau]

Thank you I have found and fixed the problem in the code that was provided
q8 had to be changed to q7

[Marsau]

And once again an error found. If i select March in shopping list day 30 should be menu 16 and is reading 17 and day 31 also menu 17
dont know how to fix

[Marsau]

SO impressed with myself....got all issues fixed.

Once again thank you to Kennith Hobs for all the help.