Private Sub Worksheet_Change(ByVal Target As Range)
Dim Changed As Range, rw As Range, cellTeam As Range, rAnchorDate As Range, rTracker As Range, rData As Range
Dim rwTeam As Long, NumDays As Long, TeamClr As Long, AnchorDate As Long, AnchorCol As Long, StartDateCol As Long, oSet As Long, lc As Long
Dim TeamName As String
Dim aColours As Variant
Const TeamColours As String = "$Team1:50|$TEAM2:4|$Team3:33|$TEAM4:6|$TEAM5:22|$Team6:45|$Misc Events:35" '<- Adjust team names and colour values here
Set rData = Columns("A").Find(What:="Team Name", LookAt:=xlWhole, SearchDirection:=xlPrevious, MatchCase:=False).Offset(1)
Set rData = rData.Resize(Cells.SpecialCells(xlCellTypeLastCell).Row - rData.Row + 1, 7)
Set Changed = Intersect(Target, rData)
If Not Changed Is Nothing Then
Application.EnableEvents = False
On Error GoTo AEET
lc = Cells(3, Columns.Count).End(xlToLeft).Column
Set rTracker = Range("B4").Resize(Columns("A").Find(What:="Report Period", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious, MatchCase:=False).Row - 4, lc - 1)
Set rAnchorDate = rTracker.Cells(0, 1)
AnchorDate = rAnchorDate.Value
AnchorCol = rAnchorDate.Column
aColours = Split(TeamColours, "|")
With rTracker
.ClearContents
.Interior.ColorIndex = xlNone
.HorizontalAlignment = xlGeneral
End With
For Each rw In rData.Rows
TeamName = rw.Cells(1).Value
If Len(TeamName) > 0 Then
Set cellTeam = Range("A4:A17").Find(What:=TeamName, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not cellTeam Is Nothing Then
rwTeam = cellTeam.Row
NumDays = rw.Cells(7).Value - rw.Cells(6).Value + 1
oSet = rw.Cells(6).Value - AnchorDate
StartDateCol = AnchorCol + oSet
With Cells(rwTeam, StartDateCol).Resize(, NumDays)
.Cells(1).Value = rw.Cells(2).Value
.HorizontalAlignment = xlCenterAcrossSelection
If InStr(1, TeamColours, "$" & TeamName & ":", vbTextCompare) > 0 Then
TeamClr = Split(Mid(TeamColours, InStr(1, TeamColours, "$" & TeamName & ":", vbTextCompare) + Len(TeamName) + 2), "|")(0)
.Interior.ColorIndex = TeamClr
End If
End With
End If
End If
Next rw
End If
AEET:
Application.EnableEvents = True
End Sub