Private Sub Worksheet_Change(ByVal target As Range)
process
End Sub
Sub process()
Dim taskID
Dim taskName
Dim taskType
Dim taskRole
Dim taskStart
Dim taskDue
Dim taskRow
Dim taskCol
Dim fromColumn
Dim toColumn
Dim firstDate
Dim target As Worksheet
Dim row As Range
'-- initialise
firstDate = CDate(Now)
Const targetName = "Result"
'-- remove existing result
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets(targetName).Delete
Application.DisplayAlerts = True
On Error GoTo 0
'-- generate result sheet
Set target = Worksheets.Add
target.Name = "Result"
target.Range("A2") = "ID.#"
target.Range("B2") = "Task"
target.Range("C2") = "Start"
target.Range("D2") = "Due"
target.Range("E2").Formula = "=E1+4"
target.Range("F1").Formula = "=E1+7"
target.Range("F2").Formula = "=E2+7"
target.Range("F1:F2").AutoFill target.Range("F1:X2")
target.Range("E1:X2").NumberFormat = "d-m-yyyy"
target.Range("A:A").ColumnWidth = 8.43
target.Range("B:B").ColumnWidth = 17.71
target.Range("C:X").ColumnWidth = 12.29
target.Rows.RowHeight = 15.75
target.Cells.Font.Size = 12
ActiveWindow.Zoom = 75
target.Range("E3:J17").Select
ActiveWindow.FreezePanes = True
'-- process first start date
For Each row In UsedRange.Rows
taskStart = row.Cells(6)
If IsDate(taskStart) And taskStart < firstDate Then firstDate = taskStart
Next row
target.Range("E1") = firstDate
'-- process input data
For Each row In UsedRange.Rows
'-- skip header & empty rows
If IsNumeric(row.Cells(1)) Then
taskID = row.Cells(1)
taskName = row.Cells(2)
taskRole = row.Cells(5)
taskStart = row.Cells(6)
taskDue = row.Cells(7)
If taskID = CInt(taskID) Then
taskType = "Major task"
Else
taskType = "Minor task"
End If
'-- fill result sheet
taskRow = target.UsedRange.row + target.UsedRange.Rows.Count
target.Range("A" & taskRow) = taskID
target.Range("B" & taskRow) = taskType
target.Range("C" & taskRow) = taskStart
target.Range("D" & taskRow) = taskDue
target.Range("B" & taskRow).Font.Color = -16776961
'-- locate 'R' entries
If UCase(taskRole) = "R" Then
'-- determine start column
fromColumn = 0
toColumn = 0
For Each Item In target.Range("E2:X2")
If fromColumn = 0 And taskStart >= Item.Offset(-1, 0) And taskStart <= Item Then fromColumn = Item.Column
If fromColumn > 0 And taskDue >= Item.Offset(-1, 0) And taskDue <= Item Then toColumn = Item.Column: Exit For
Next Item
'-- toColumn=0 --> item due before first column in gantt sheet
If toColumn > 0 Then
For taskCol = fromColumn To toColumn
target.Cells(taskRow, taskCol).Interior.ThemeColor = xlThemeColorAccent1
Next taskCol
End If
End If
End If
Next row
target.Range("A1").Select
Me.Select
Application.ScreenUpdating = True
End Sub
Const targetName = "Result"
{code}line 1
line 2
line 3{/code}
line 1
line 2
line 3
target.Range("B" & taskRow) = taskType
totarget.Range("B" & taskRow) = taskName
[...]
target.Range("G1").Formula = "=F1+7"
target.Range("G2").Formula = "=F2+7"
target.Range("G1:G2").AutoFill target.Range("G1:Y2")
target.Range("F1:Y2").NumberFormat = "d-m-yyyy"
[...]
target.Range("C:Y").ColumnWidth = 12.29
[...]
target.Range("F3:K17").Select
[...]
target.Range("F1") = firstDate
[...]
target.Range("A" & taskRow) = taskID
target.Range("B" & taskRow) = taskType
[b]target.Range("C" & taskRow) = taskName[/b]
target.Range("D" & taskRow) = taskStart
target.Range("E" & taskRow) = taskDue
[...]
For Each Item In target.Range("F2:Y2")
[...]