Hi
First post, so please excuse if added items/references wrong.
I am trying to develop a Gantt using VBA, I cannot use the Conditional Fromatting style or any style that prevents me from referencing the date cells which have colour or text.
I would like to have two sheets. Sheet 1 = Gantt and sheet 2 will have a lookup for specific engineer.
My initial thought is to create a gantt ffrom which I can Index match (or similar, perhaps even use VBA again) and populate the date ranges booked in sheet one against each engineers name in sheet 2
Code I have used so far seems to hang Excel, but if I add "Stop" before "End Sub " it does both colour and add text.
Any assistance would be appreciated.
CODE:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, j As Integer
ScreenUpdating = False
On Error Resume Next
FirstRow = Sheets("Sheet1").Usedrange.Rows(2).Row
LastRow = Sheets("Sheet1").Usedrange.Rows(ActiveSheet.Usedrange.Rows.Count).Row
LastCol = Sheets("Sheet1").Usedrange.Columns(ActiveSheet.Usedrange.Columns.Count).Column
With Sheets("Sheet1")
For j = 5 To LastCol
For i = 2 To LastRow
If Sheets("Sheet1").Application.WorksheetFunction.IsText(Cells(i, 1)) = True And Cells(1, j).Value >= Cells(i, 3).Value And Cells(1, j).Value <= Cells(i, 4).Value Then
Sheets("Sheet1").Usedrange.Cells(i, j).Value = Cells(i, 2)
Sheets("Sheet1").Usedrange.Cells(i, j).Interior.ColorIndex = 4
End If
Next
Next
End With
ScreenUpdating = True
End Sub
Sheet 2
<tbody>
</tbody>
Sheet 1
<tbody>
</tbody>
First post, so please excuse if added items/references wrong.
I am trying to develop a Gantt using VBA, I cannot use the Conditional Fromatting style or any style that prevents me from referencing the date cells which have colour or text.
I would like to have two sheets. Sheet 1 = Gantt and sheet 2 will have a lookup for specific engineer.
My initial thought is to create a gantt ffrom which I can Index match (or similar, perhaps even use VBA again) and populate the date ranges booked in sheet one against each engineers name in sheet 2
Code I have used so far seems to hang Excel, but if I add "Stop" before "End Sub " it does both colour and add text.
Any assistance would be appreciated.
CODE:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, j As Integer
ScreenUpdating = False
On Error Resume Next
FirstRow = Sheets("Sheet1").Usedrange.Rows(2).Row
LastRow = Sheets("Sheet1").Usedrange.Rows(ActiveSheet.Usedrange.Rows.Count).Row
LastCol = Sheets("Sheet1").Usedrange.Columns(ActiveSheet.Usedrange.Columns.Count).Column
With Sheets("Sheet1")
For j = 5 To LastCol
For i = 2 To LastRow
If Sheets("Sheet1").Application.WorksheetFunction.IsText(Cells(i, 1)) = True And Cells(1, j).Value >= Cells(i, 3).Value And Cells(1, j).Value <= Cells(i, 4).Value Then
Sheets("Sheet1").Usedrange.Cells(i, j).Value = Cells(i, 2)
Sheets("Sheet1").Usedrange.Cells(i, j).Interior.ColorIndex = 4
End If
Next
Next
End With
ScreenUpdating = True
End Sub
Sheet 2
| ENGINEER | 21/01/2017 | 22/01/2017 | 23/01/2017 | 24/01/2017 | 25/01/2017 | 26/01/2017 | 27/01/2017 | 28/01/2017 | 29/01/2017 | 30/01/2017 | 31/01/2017 | 01/02/2017 | 02/02/2017 |
| Engineer 1 | AD | AD | AD | WD | WD | ||||||||
| Engineer 2 | A3 | A3 | A3 | A3 | A3 | A3 | A3 | ||||||
| Engineer 3 | A4 | A4 | A4 | A4 | A4 | A4 | A4 | A4 | |||||
| Engineer 4 | A5 | A5 | A5 | A5 | A5 | A5 | A5 | A5 | A5 | ||||
| Engineer 5 | A6 | A6 | A6 | A6 | A6 | A6 | A6 | A6 | A6 | A6 | |||
| Engineer 6 | A7 | A7 | A7 | A7 | A7 | A7 | A7 | A7 | A7 | A7 | A7 | ||
| Engineer 7 | A9 | A9 | A9 | A9 | A9 | A9 | A9 | A9 | A9 | A9 | A9 | A9 |
<tbody>
</tbody>
Sheet 1
| ENGINEER | PROJECT | START DATE | END DATE | 21/01/2017 | 22/01/2017 | 23/01/2017 | 24/01/2017 | 25/01/2017 | 26/01/2017 | 27/01/2017 | 28/01/2017 | 29/01/2017 | 30/01/2017 | 31/01/2017 | 01/02/2017 | 02/02/2017 |
| Engineer 1 | WD | 24/01/2017 | 26/01/2017 | AD | AD | AD | ||||||||||
| Engineer 1 | WD | 25/01/2017 | 26/01/2017 | WD | WD | |||||||||||
| Engineer 2 | A3 | 21/01/2017 | 27/01/2017 | A3 | A3 | A3 | A3 | A3 | A3 | A3 | ||||||
| Engineer 3 | A4 | 21/01/2017 | 28/01/2017 | A4 | A4 | A4 | A4 | A4 | A4 | A4 | A4 | |||||
| Engineer 4 | A5 | 21/01/2017 | 29/01/2017 | A5 | A5 | A5 | A5 | A5 | A5 | A5 | A5 | A5 | ||||
| Engineer 5 | A6 | 21/01/2017 | 30/01/2017 | A6 | A6 | A6 | A6 | A6 | A6 | A6 | A6 | A6 | A6 | |||
| Engineer 6 | A7 | 21/01/2017 | 31/01/2017 | A7 | A7 | A7 | A7 | A7 | A7 | A7 | A7 | A7 | A7 | A7 | ||
| Engineer 7 | A9 | 21/01/2017 | 01/02/2017 | A9 | A9 | A9 | A9 | A9 | A9 | A9 | A9 | A9 | A9 | A9 | A9 |
<tbody>
</tbody>
