Initial coding for solution to this Thread
http://www.excelfox.com/forum/showth...ll=1#post11124


File : "Data Sheet.xls" : https://app.box.com/s/wvusyk3ish5z3mxdwvw3sw9n683m58rq

Code:
Option Explicit '
Sub HaiderAdSlots1() ' http://www.excelfox.com/forum/showthread.php/2330-Fill-Column-Based-on-Actual-Time?p=11124&viewfull=1#post11124
Rem 1 Worksheets info
Dim Ws1 As Worksheet, Ws2 As Worksheet
 Set Ws1 = ThisWorkbook.Worksheets("Sheet1"): Set Ws2 = ThisWorkbook.Worksheets("Sheet2")
Dim Lr1 As Long, Lr2 As Long
 Let Lr1 = Ws1.Range("A" & Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row & "").Row: Let Lr2 = Ws1.Range("A" & Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row & "").Row
'1b) data arrays, original data
Dim arrInSht2() As Variant, arrOutSht1() As Variant
 Let arrInSht2() = Ws2.Range("A1:G" & Lr2 & "").Value2: Let arrOutSht1() = Ws1.Range("A1:C" & Lr1 & "").Value2
'1b)(ii) extra "column" for outout
ReDim Preserve arrOutSht1(1 To Lr1, 1 To 4) ' we may add a last dimension, but must keep the others the same as they were
Rem 2 arrays to identify rows ... " Channel Name &  Date & Time "
Dim arrInId() As String
 ReDim arrInId(1 To Lr2)
Dim cnt As Long
    For cnt = 2 To Lr2
     Let arrInId(cnt) = arrInSht2(cnt, 1) & " | " & arrInSht2(cnt, 2) & " | " & arrInSht2(cnt, 3)
    Next cnt
Dim arrOutId() As String
 ReDim arrOutId(1 To Lr1)
    For cnt = 2 To Lr1
     Let arrOutId(cnt) = arrOutSht1(cnt, 2) & " | " & arrOutSht1(cnt, 1) & " | " & arrOutSht1(cnt, 3)
    Next cnt
Rem 3 match up rows in data sheets
    For cnt = 2 To Lr1
    Dim MtchRes As Variant
     Let MtchRes = Application.Match(arrOutId(cnt), arrInId(), 1) ' return the position along of a match   ( looking for arrOutId(cnt) ,   in arrInId()   , 1 indicates approximate match )
        If Not IsError(MtchRes) Then
        '3b)
         Let arrOutSht1(cnt, 4) = arrInSht2(MtchRes, 3)
        Else
        End If
    Next cnt
Rem 4
 Let ThisWorkbook.Worksheets("OutputTest").Range("A1").Resize(UBound(arrOutSht1(), 1), 4).Value = arrOutSht1()
 
End Sub