Take data with start and end data and add it to my excell callender area

[tonywatsonhelp]

Hi Everyone,

Ok so I have a sheet called "Cal" that is made up of Event Names Down Column H and Dates from 1st April 2018 to 1st April 2021 along Row 10 (Range J10:APM10)

I have another sheet called "Data"

Down Column D is the Event Name, Column E is start date, Column F is end date.

so what I need is a macro to fill in my calendar in sheet "Cal" with the appointments in sheet Data.

So I need the macro to look at each row in Column D of Data and find that project name in "Cal" Column H
then look at the start date and end date and insert the word "Out" into each cell for that appointment then move on to the next etc.

So basicly take the appointment in sheet "Data" and add them to my "Cal" sheet using the name and the dates.

any ideas how I could do this?

Thanks

Tony

 

[wideboydixon]

Hey Tony,

Give this a bash:

Public Sub FillCalendar()

Dim dataSheet As Worksheet
Dim calSheet As Worksheet
Dim lastRow As Long
Dim thisRow As Long
Dim foundRow As Variant
Dim startDate As Date
Dim endDate As Date
Dim thisDate As Date
Dim firstDate As Date

Set dataSheet = Sheets("Data")
lastRow = dataSheet.Cells(dataSheet.Rows.Count, "D").End(xlUp).Row
Set calSheet = Sheets("Cal")
firstDate = calSheet.Range("J10").Value

For thisRow = 1 To lastRow
    foundRow = Application.Match(dataSheet.Cells(thisRow, "D").Value, calSheet.Range("H:H"), 0)
    If Not IsError(foundRow) Then
        startDate = dataSheet.Cells(thisRow, "E").Value
        endDate = dataSheet.Cells(thisRow, "F").Value
        If startDate >= firstDate And endDate >= startDate Then
            For thisDate = startDate To endDate
                calSheet.Cells(foundRow, thisDate - firstDate + 10).Value = "Out"
            Next thisDate
        End If
    End If
Next thisRow

End Sub

WBD

 

[tonywatsonhelp]

Thank you wideboy,

This is great

Tony