Filling blanks in an project / employee planning schedule

50 Views Asked by At

I asked this question earlier but wasn't able to attach a screenshot, so I'm reuploading it here.

Screenshot with requirements

I have a list of project start dates & end dates (as well as employee assigned), on which I used Excel formula to populate in a timeline sheet as values.

  • For the week where an employee is expected to start a project, the project name will appear in the corresponding cell / week under their name.
  • Same logic applies to Project End.

Essentially in an employee's row, they will see cells populated with names of projects for the starting week and ending week. Anything in between will be blank.

Additionally, if they have idle time, they will also have blank cells.

My Question is this: the below code fills in the idle time with project name of the first project as well. How do I avoid this?

Sub FillProjectDate_TEST2()
Dim ws As Worksheet
Dim lastRow As Long, lastCol As Long
Dim i As Long, j As Long
Dim startCol As Long, endCol As Long
Dim project As String
Set ws = ThisWorkbook.Sheets("Test")
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row
lastCol = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column
' Loop through each row starting from row 4
For i = 4 To lastRow
    ' Reset start and end dates for each row
    startCol = 0: endCol = 0
    ' Loop through each column (week). First week is in column B.
    For j = 2 To lastCol
        ' Check if the cell has a project name
        If ws.Cells(i, j).Value <> "" Then
            ' Always update end date to the current date
            endCol = j
            ' If start date is not set, set it
            If startCol = 0 Then
                startCol = j
                project = ws.Cells(i, j).Value ' Store project name
            Else
                If startCol * endCol > 0 Then
                    ws.Cells(i, startCol).Resize(1, endCol - startCol).Value = project
                End If
                startCol = j
                project = ws.Cells(i, j).Value
            End If
        End If
    Next j
    ' Fill in cells for the last project name in each row
    'If startCol < lastCol Then
        'ws.Cells(i, startCol).Resize(1, lastCol - startCol + 1).Value = project
    'End If
Next i
End Sub
0

There are 0 best solutions below