If And formula

[KlausW]

Hi I am working on a diet registration projects and hope some can help.
In the Registration sheet in cell B3 to B10 I have dates, these I change by a Dropdown list weekly. In cell A2 I have a Dropdown list of initials of people on board.
In columns C3 to C10, E3 to E10, G3 to G10 I then enter who is eating on board. These I would like copies, and pasted in the sheet Time. Based on Date in column C and initials in row 1.
I have tried with the formula

= IF (AND (Tilmelding! $ I $ 4 = C3; Tilmelding! $ A $ 2 = $ G $ 1); Tilmelding! $ C $ 4; "")

But this does not work as the numbers disappear if I change in the 2 Dropdown lists.
All help will be appreciated

Regards Klaus W

Red line Initials
Orange Line Date
Green line Breakfast
Blue line Breakfast
Yellow line Dinner

 

[Snakehips]

@KlausW I'm afraid that you will not be able to achieve this by using formulas.
As you have already found, the results you have illustrated for initials JRK will disappear when you enter NK and vice versa .
You will likely need to use VBA where you click button to transfer the values of each Date / Initials combo to the Tim sheet.

 

[KlausW]

@KlausW I'm afraid that you will not be able to achieve this by using formulas.
As you have already found, the results you have illustrated for initials JRK will disappear when you enter NK and vice versa .
You will likely need to use VBA where you click button to transfer the values of each Date / Initials combo to the Tim sheet.

I thought so, but I'm not familiar with VBA

@KlausW I'm afraid that you will not be able to achieve this by using formulas.
As you have already found, the results you have illustrated for initials JRK will disappear when you enter NK and vice versa .
You will likely need to use VBA where you click button to transfer the values of each Date / Initials combo to the Tim sheet.

I thought so, but I'm not familiar with VBA

 

[KlausW]

I thought so, but I'm not familiar with VBA

 

[Snakehips]

I will try and help.

 

[Snakehips]

As far as I can interpret from your original post, this may do it.
Paste the code to either a sheet or a code module within the vba editor.
Run it direct from there to test.
Then assign it to a button if good.

Sub Update_Tid()
Dim DatRng, Dest As Range
Dim TidCol, TidRow, c  As Integer

 With Sheets("Tilmelding")
    Set DatRng = .Range("C4:C10")
 On Error GoTo Ooops
    TidCol = Application.Match(.Range("A2"), Sheets("Tid").Range("1:1"), 0)
    TidRow = Application.Match(.Range("B4"), Sheets("Tid").Range("C:C"), 0)
 End With
 
For c = 0 To 2
    Set Dest = Sheets("Tid").Cells(TidRow, TidCol).Offset(0, c).Resize(7, 1)
    Dest.Value = DatRng.Offset(0, 2 * c).Value
 Next c
 
Ooops:
 If Not Err.Number = 0 Then MsgBox " Not able to match Initial or Date  -- Please check and try again"
On Error GoTo 0
 
End Sub

Rightly or wrongly, this will send a weeks worth of data across.

Hope that helps.

 

[KlausW]

Godmor

As far as I can interpret from your original post, this may do it.
Paste the code to either a sheet or a code module within the vba editor.
Run it direct from there to test.
Then assign it to a button if good.

Sub Update_Tid()
Dim DatRng, Dest As Range
Dim TidCol, TidRow, c  As Integer

 With Sheets("Tilmelding")
    Set DatRng = .Range("C4:C10")
 On Error GoTo Ooops
    TidCol = Application.Match(.Range("A2"), Sheets("Tid").Range("1:1"), 0)
    TidRow = Application.Match(.Range("B4"), Sheets("Tid").Range("C:C"), 0)
 End With
 
For c = 0 To 2
    Set Dest = Sheets("Tid").Cells(TidRow, TidCol).Offset(0, c).Resize(7, 1)
    Dest.Value = DatRng.Offset(0, 2 * c).Value
 Next c
 
Ooops:
 If Not Err.Number = 0 Then MsgBox " Not able to match Initial or Date  -- Please check and try again"
On Error GoTo 0
 
End Sub

Rightly or wrongly, this will send a weeks worth of data across.

Hope that helps.

Good morning Snakehips from Denmark, it is simply just perfect. I have a small thing it is possible that columns C3 to C10, E3 to E10, G3 to G10 show what is written in the sheet Tid. So when I change the Dropdown lists in A2 and G2 it changes according to what is entered. best Regards Klaus W

 

[Snakehips]

Godmor

Good morning Snakehips from Denmark, it is simply just perfect. I have a small thing it is possible that columns C3 to C10, E3 to E10, G3 to G10 show what is written in the sheet Tid. So when I change the Dropdown lists in A2 and G2 it changes according to what is entered. best Regards Klaus W

Good afternoon Klaus, from England. I am pleased to have helped.
Please do not worry about your thing. Size isn't everything! ?

As for updating as and when you change selection in A2 or G2, try the below.
Paste the code into the Worksheet code module for the "Tilmelding" sheet, not in a Code Module.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("A2", "G2")) Is Nothing Then Exit Sub

Dim WkRng, DestRng, SrcRng As Range
Dim TidCol, TidRow, c  As Integer

 With Sheets("Tilmelding")
    Set WkRng = .Range("B4:B10")  'Dates for week number
    Set DestRng = .Range("C4:C10")  'Required qty range
    
    On Error GoTo Ooops  'Error handler
    'TidCol = first column of initial
    'TidRow = first row of week number
       TidCol = Application.Match(.Range("A2"), Sheets("Tid").Range("1:1"), 0)
       TidRow = Application.Match(.Range("G2"), Sheets("Tid").Range("B:B"), 0)
 End With
Application.EnableEvents = False  'Stop this change event code triggereing itself and looping forever
'change the dates to match week number
WkRng.Value = Sheets("Tid").Cells(TidRow, 3).Resize(7, 1).Value

'Loop using offset to get 3 sets of data from Tid to cols C E G
For c = 0 To 2
    Set SrcRng = Sheets("Tid").Cells(TidRow, TidCol).Offset(0, c).Resize(7, 1)
    DestRng.Offset(0, 2 * c).Value = SrcRng.Value
Next c
 
Ooops:  'Error message if there is error.
 If Not Err.Number = 0 Then MsgBox " Not able to match Initial or Week Number  -- Please check and try again"

On Error GoTo 0  'set error handling back to default
Application.EnableEvents = True  're-enable events handling

End Sub

Hope that helps.

 

[KlausW]

Good afternoon Klaus, from England. I am pleased to have helped.
Please do not worry about your thing. Size isn't everything! ?

As for updating as and when you change selection in A2 or G2, try the below.
Paste the code into the Worksheet code module for the "Tilmelding" sheet, not in a Code Module.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("A2", "G2")) Is Nothing Then Exit Sub

Dim WkRng, DestRng, SrcRng As Range
Dim TidCol, TidRow, c  As Integer

 With Sheets("Tilmelding")
    Set WkRng = .Range("B4:B10")  'Dates for week number
    Set DestRng = .Range("C4:C10")  'Required qty range
   
    On Error GoTo Ooops  'Error handler
    'TidCol = first column of initial
    'TidRow = first row of week number
       TidCol = Application.Match(.Range("A2"), Sheets("Tid").Range("1:1"), 0)
       TidRow = Application.Match(.Range("G2"), Sheets("Tid").Range("B:B"), 0)
 End With
Application.EnableEvents = False  'Stop this change event code triggereing itself and looping forever
'change the dates to match week number
WkRng.Value = Sheets("Tid").Cells(TidRow, 3).Resize(7, 1).Value

'Loop using offset to get 3 sets of data from Tid to cols C E G
For c = 0 To 2
    Set SrcRng = Sheets("Tid").Cells(TidRow, TidCol).Offset(0, c).Resize(7, 1)
    DestRng.Offset(0, 2 * c).Value = SrcRng.Value
Next c
 
Ooops:  'Error message if there is error.
 If Not Err.Number = 0 Then MsgBox " Not able to match Initial or Week Number  -- Please check and try again"

On Error GoTo 0  'set error handling back to default
Application.EnableEvents = True  're-enable events handling

End Sub

Hope that helps.

Thank U so m

Good afternoon Klaus, from England. I am pleased to have helped.
Please do not worry about your thing. Size isn't everything! ?

As for updating as and when you change selection in A2 or G2, try the below.
Paste the code into the Worksheet code module for the "Tilmelding" sheet, not in a Code Module.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("A2", "G2")) Is Nothing Then Exit Sub

Dim WkRng, DestRng, SrcRng As Range
Dim TidCol, TidRow, c  As Integer

 With Sheets("Tilmelding")
    Set WkRng = .Range("B4:B10")  'Dates for week number
    Set DestRng = .Range("C4:C10")  'Required qty range
   
    On Error GoTo Ooops  'Error handler
    'TidCol = first column of initial
    'TidRow = first row of week number
       TidCol = Application.Match(.Range("A2"), Sheets("Tid").Range("1:1"), 0)
       TidRow = Application.Match(.Range("G2"), Sheets("Tid").Range("B:B"), 0)
 End With
Application.EnableEvents = False  'Stop this change event code triggereing itself and looping forever
'change the dates to match week number
WkRng.Value = Sheets("Tid").Cells(TidRow, 3).Resize(7, 1).Value

'Loop using offset to get 3 sets of data from Tid to cols C E G
For c = 0 To 2
    Set SrcRng = Sheets("Tid").Cells(TidRow, TidCol).Offset(0, c).Resize(7, 1)
    DestRng.Offset(0, 2 * c).Value = SrcRng.Value
Next c
 
Ooops:  'Error message if there is error.
 If Not Err.Number = 0 Then MsgBox " Not able to match Initial or Week Number  -- Please check and try again"

On Error GoTo 0  'set error handling back to default
Application.EnableEvents = True  're-enable events handling

End Sub

Hope that helps.

Dear Snakehips
Thank You very much, unfortunately I can not make it work. Nor when I change Cell A2 or Cell G2. Excel does not move anything. I have put the code in the Worksheet code module for the "Registration" sheet
Regards Klaus W

 

[Snakehips]

Ok. If your tab name is "Registration" not "Tilmelding" then change "Timelding" within that code to "Registration"

I have to say that I am confused since the previous code worked with the Danishl sheet names?