VBA-Perform lookup for all rows in column if date selected?

I am hoping to find a way to select a date at the top of a column and perform a look for all of the cells below it, and a different lookup for those one row to the right.

I have copied a bunch of things found and then went through chatgpt but what I'm getting from it isn't working. I originally was going to do this with xlookups on all of the cells which I finally got working, but the data behind it is huge and the user wont need all of them.

I've attached an example and the code I have is below. Also below are the formulas that work to pull the data in case that helps.

Left Column:'=XLOOKUP($D7&TEXT($E$6, "mm/dd/yyyy"),data[Helper], data[Result],0,0)  &  Right Column:'=XLOOKUP($D7&TEXT($K$6, "mm/dd/yyyyy"),data[Helper],data[Day]&CHAR(10)&TEXT(data[time], "hh:mm"))

Sub loaddata()

Dim ActiveCell As Range
Dim Lookup1 As Variant
Dim Lookup2 As Variant
Dim ec As Range
Dim Result As Variant
Dim ws As Workbook
Dim sc As Range
Dim ic As Range
Set sc = ThisWorkbook.Worksheets("data").Range("Helper")
Set ec = Sheets("data").Range("Day")
Set tc = Sheets("data").Range("Time")
Set res = Sheets("data").Range("Res")
Set ActiveCell = ActiveCell

'If Date selected in Row 5, perform for the two columns below
'how to set format for time hh:mm?
Lookup1 = LookupValue = ActiveCell.Offset(0, -1).Value
Lookup2 = ActiveCell.EntireColumn.Rows(3)

On Error Resume Next
'Primary Column Result
Result = Application.WorksheetFunction.XLookup(Lookup1 & Lookup2, sc, ec)
'One column to the right
Result = Application.WorksheetFunction.XLookup(Lookup1 & Lookup2, sc, res & tc)

On Error GoTo 0

If Not IsError(Result) Then
ActiveCell.Value = Result
Else: MsgBox "Didn't work"

End If


End Sub