0

I am creating a custom "work schedule" planner within excel with various userforms and controls. In this workbook main sheet with all of the data looks like this:

Task1 | Worker 1 | Supervisor 1 | Due Date 1(W) | Due Date 2(S)
Task2 | Worker 2 | Supervisor 2 | Due Date 2(W) | Due Date 3(S)
Task3 | Worker 3 | Supervisor 1 | Due Date 1(W) | Due Date 2(S)
Task4 | Worker 2 | Supervisor 2 | Due Date 4(W) | Due Date 5(S)
Task5 | Worker 1 | Supervisor 1 | Due Date 3(W) | Due Date 4(S)

What I need is to construct a calendar style representation of this data on separate sheet for specific month. I have over 20 workers, suveral supervisors, tasks are unique (over 200), due dates may be repeated (i.e. various amount of rows per worker per week). In the format like this:

              Business_Week1 Business_Week2 Business_Week3 Business_Week4
Supervisor 1  Task           Task           Task           Task
SuperVisor 2  Task           Task           Task           Task
Worker 1      Task           Task           Task           Task
Worker 2      Task           Task           Task           Task
Worker 3      Task           Task           Task           Task

As i understand, i would need several subs/functions to carry out such complex process: 1) Creating business week dates (Mon-Fri) for chosen month. 2) Finding array of unique values in columns "worker" \ "supervisor" 3) Getting function to check if due date falls between business week 4) Use loop for each worker\supervisor and date function to paste tasks into relevant column of business week, for each of personell.

I managed to make, find some of this steps, but struggling to combine into one and do main procidure.

Function BetweenDates(startDate As String, endDate As String, testDate As String) As Boolean
    BetweenDates = IIf(CDate(testDate) >= CDate(startDate) And CDate(testDate) <= CDate(endDate), True, False)
End Function

Sub BusinessWeeks()
    Dim dStart As Date
    Dim dEnd As Date
    Dim rw As Integer
    Dim C_month As Date

    C_month = "01/10/2017"
FirstDayInMonth = DateSerial( _
 Year(C_month), Month(C_month), 1)

LastDayInMonth = DateSerial( _
 Year(C_month), Month(C_month) + 1, 0)

    rw = 2
    While FirstDayInMonth < LastDayInMonth
        If Weekday(FirstDayInMonth) = vbMonday Then
            Cells(2, rw).value = FirstDayInMonth
            Cells(2, rw).NumberFormat = "dd/mm/yyyy"
        End If
        If Weekday(FirstDayInMonth) = vbFriday Then
            Cells(3, rw).value = FirstDayInMonth
            Cells(3, rw).NumberFormat = "dd/mm/yyyy"
            rw = rw + 1
        End If
        FirstDayInMonth = FirstDayInMonth + 1
    Wend
End Sub

Sub FindUnique()

    Dim varIn As Variant
    Dim varUnique As Variant
    Dim iInCol As Long
    Dim iInRow As Long
    Dim iUnique As Long
    Dim nUnique As Long
    Dim isUnique As Boolean

    varIn = Selection
    ReDim varUnique(1 To UBound(varIn, 1) * UBound(varIn, 2))

    nUnique = 0
    For iInRow = LBound(varIn, 1) To UBound(varIn, 1)
        For iInCol = LBound(varIn, 2) To UBound(varIn, 2)

            isUnique = True
            For iUnique = 1 To nUnique
                If varIn(iInRow, iInCol) = varUnique(iUnique) Then
                    isUnique = False
                    Exit For
                End If
            Next iUnique

            If isUnique = True Then
                nUnique = nUnique + 1
                varUnique(nUnique) = varIn(iInRow, iInCol)
            End If

        Next iInCol
    Next iInRow
    ReDim Preserve varUnique(1 To nUnique)

End Sub

How can i combine these and add loop statements to achive the goal? Thanks in advance!

Community
  • 1
  • 1
NewUser
  • 3
  • 2

0 Answers0