Option Explicit
Sub DKBuildReport()
Dim rngName As Range
Dim sName As String
Dim lRowNum As Long
Dim lColNum As Long
Dim sColour As String
Dim rngPerfGrid As Range
Dim rngGridCell As Range
Dim rngColour As Range
'-----------------------------------------------
'Set Initial references and Clear Reports
'-----------------------------------------------
'Set the reference to the Result Grid
Set rngPerfGrid = ThisWorkbook.Worksheets("Performance Grid").Range("B7:K11")
'Reset the Performance Grid
With rngPerfGrid
.ClearContents
.Rows.AutoFit
End With
'Reset the Colour Reports
With ThisWorkbook.Worksheets("Performance Grid")
.Range(.Range("rngPINK").Offset(1, 0), .Range("rngPINK").End(xlDown)).ClearContents
.Range(.Range("rngYELLOW").Offset(1, 0), .Range("rngYELLOW").End(xlDown)).ClearContents
.Range(.Range("rngORANGE").Offset(1, 0), .Range("rngORANGE").End(xlDown)).ClearContents
.Range(.Range("rngGREEN").Offset(1, 0), .Range("rngGREEN").End(xlDown)).ClearContents
.Range(.Range("rngDARKORANGE").Offset(1, 0), .Range("rngDARKORANGE").End(xlDown)).ClearContents
.Range(.Range("rngPALEBLUE").Offset(1, 0), .Range("rngPALEBLUE").End(xlDown)).ClearContents
.Range(.Range("rngDEEPBLUE").Offset(1, 0), .Range("rngDEEPBLUE").End(xlDown)).ClearContents
End With
'Start with the first name
Set rngName = ThisWorkbook.Worksheets("Manager Input").Range("A3")
Do
'-----------------------------------------------
'Get inputs
'-----------------------------------------------
'Get the employee name
sName = rngName.Value
'The Grid Row
lRowNum = rngName.Offset(0, 16)
'The Grid Column
lColNum = rngName.Offset(0, 17)
'And the Colour
sColour = rngName.Offset(0, 18)
'-----------------------------------------------
'Populate Main Grid
'-----------------------------------------------
'Set the target cell range in the main grid
Set rngGridCell = rngPerfGrid.Cells(lRowNum, lColNum)
With rngGridCell
'Either add to the target cell or
'The next cell to the right
If .RowHeight < 400 Then
.Value = .Value & sName & Chr(10)
Else
.Offset(0, 1).Value = .Offset(0, 1).Value & sName & Chr(10)
End If
'If lRowNum = 2 Then Stop
'Adjust the row height
.Rows.AutoFit
If .RowHeight <= 60 Then
.RowHeight = 60
ElseIf .RowHeight < 400 Then
.RowHeight = .RowHeight + 2
End If
End With
'-----------------------------------------------
'Populate Colour Grid
'-----------------------------------------------
'Set a reference to the colour Header
Set rngColour = ThisWorkbook.Worksheets("Performance Grid").Range(sColour)
With rngColour
If .Offset(1, 0).Value = "" Then
.Offset(1, 0).Value = sName
Else
.End(xlDown).Offset(1, 0).Value = sName
End If
End With
'-----------------------------------------------
'Move to the next cell
'-----------------------------------------------
Set rngName = rngName.Offset(1, 0)
Loop Until rngName.Value = ""
End Sub