Formula / VBA to help automate updating cell based on date/value

[terrib1e]

Here is a very simplified version of what I need help with. I'm trying to update dates people at my company put into our pto calendar in outlook in our availability spreadsheet.

On one worksheet I have a list of names in Column A and a list of dates across Row 1.

	1/1/2018	1/2/2018	1/3/2018	1/4/2018
Name 1
Name 2
Name 3
Name 4
Name 5
Name 6
Name 7

<tbody>
</tbody>

In another sheet, I have a list of names and dates being pulled from an outlook calendar. I have a vba pull these appointments and insert them into a separate sheet. It looks similar to -

		start	end
Name 1		1/2/2018	1/4/2018
Name 3		1/1/2018	1/2/2018

<tbody>
</tbody>

My end goal is to automatically match these and input a "0" in the first calendar. Ultimately i'd like it to look like -

	1/1/2018	1/2/2018	1/3/2018	1/4/2018
Name 1		0%	0%	0%
Name 2
Name 3	0%	0%
Name 4
Name 5
Name 6
Name 7

<tbody>
</tbody>

Any help would be super appreciated. I'm trying to automate things as much as possible.

 

[terrib1e]

For anyone that's interested, my final code:

Sub terrib1e()
    Dim WB As Workbook: Set WB = ThisWorkbook
    Dim name As Range, foundName As Range
    Dim fDate As Range, lDate As Range
    Dim LastRow1 As Long
    Dim LastRow2 As Long
    Dim lCol As Long
    Dim WS1 As Worksheet: Set WS1 = WB.Sheets("Sheet1")
    Dim WS2 As Worksheet: Set WS2 = WB.Sheets("Sheet2")
    
    
    
    Application.ScreenUpdating = True
    
    LastRow1 = WS1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    LastRow2 = WS2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    lCol = WS1.UsedRange.Columns.Count
    
    WS1.Range(WS1.Cells(2, 2), WS1.Cells(LastRow1, lCol)).ClearContents
    
    For Each name In WS2.Range("A2:A" & LastRow2)
            Set foundName = WS1.Range("A:A").Find(name, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundName Is Nothing Then
            Set fDate = WS1.Rows(1).Find(name.Offset(0, 1))
            Set lDate = WS1.Rows(1).Find(name.Offset(0, 2))
        WS1.Range(WS1.Cells(foundName.Row, fDate.Column), WS1.Cells(foundName.Row, lDate.Column)) = 0
        End If
    Next name
    Application.ScreenUpdating = True

End Sub

 

[mumps]

Glad you picked that up. I did it for the 'ClearContents' line but I missed it for the other line.