Weekly Work Schedule using Variable Data

[HaydoC]

Hi Everyone,

I am trying to create a template so I can paste 4 columns of data from SAP (Date, Name, Hours/Job, and Job Title), but I am really struggling as a major excel amateur.
So each week, all four columns will change to suit the work that is on for that week, so I was trying to create a 'dynamic' macro that can sort the job and hours to the appropriate location in a table on a separate sheet to match the name and date of that job. Possibly using loops? Not sure though.
I have currently created 2 command buttons (one to format the data into a bit more excel friendly format, and one to transfer it to the table on the new sheet) but even that isn't going to plan yet.

Can one of you pro's please help with this? All my googling/youtube-ing is getting me no-where and doing my head in.

See below the photos of what the copied data will originally look like, the formatted data, and what I am trying to get the schedule table to look like.

Notes:
-I want any rows that are missing a name or job title from the copied data to be deleted from the schedule
-Being in Aus, I want my date format to be dd/mm/yyyy, but it appears to get confused with mm/dd/yyyy for the first 12 days of the month and I don't know how to stop that?
-The "SAP Data 2" sheet is purely just for me to test the operation of the command buttons. Once it is set up and working, that sheet will not exist.
-I do need the total 'SUM' hours of each day for each person too. I just filled the cells green to make them stand out a bit from the other cells

Here is a link to the file if you want to look at and play with what I have done already.
Weekly Schedule Draft

Thank you so much for your help in advance. This seems to be a difficult one for any regular excel users I know, so hopefully the pro's can smash this one.

 

[HaydoC]

I just realised, my current code hasn't gone through that link. Here is what I have so far (although I'm pretty sure it's wrong so feel free to just ignore this) :

Private Sub CommandButton1_Click()
On Error Resume Next
 
Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
Columns("A").NumberFormat = "dd-mm-yy"

Worksheets("SAP Data").Columns("A").Replace _
 What:=".", Replacement:="/", _
 SearchOrder:=xlByColumns, MatchCase:=True

Worksheets("SAP Data").Columns("C").Replace _
 What:=",", Replacement:=".", _
 SearchOrder:=xlByColumns, MatchCase:=True
 



End Sub

Private Sub CommandButton2_Click()

 Range("A2").Select
      Dim x As Integer
      Application.ScreenUpdating = False
           NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
           Range("A2").Select
        For x = 1 To NumRows
        
         ActiveCell.Offset(1, 0).Select
      Next
      Application.ScreenUpdating = True
      Do Until IsEmpty(ActiveCell)
         ' Insert your code here.
         ' Step down 1 row from present location.
         ActiveCell.Offset(1, 0).Select
      Loop

End Sub

 

[Rosen]

I only seem to able to download an xlsx file, not an xlsm file so your code behind the buttons isn't available to me to review: That said, lets go over your notes and see if we can at least discuss options

I am going to assume for the Format Data button you are looping through each row and changing the data, but you want to removing empty or incomplete entries. Depending on how you are looping through will determine the method to use to delete these rows, so lets go over the likely methods:

You have defined a Range object contains a column from the beginning of the list to the end we will call this Range, myRange and assume it is the Date column:
You will then want to setup a loop which will discontinue when the count of delete rows equals 0 then loop through the Range inside this loop deleting cells which meet your delete criteria. some sample code:

Dim DeleteCount As Long
Do
    DeleteCount = 0
    For Each cell In myRange
        If cell.Offset(, 1).Value = VBA.Constants.vbNullString Or cell.Offset(, 3).Value = VBA.Constants.vbNullString Then ' We have no name or Job
            Range(cell.Row & ":" & cell.Row).Delete
            DeleteCount = DeleteCount + 1
        End If
    Next
Loop Until DeleteCount = 0

There might be a more elegant solution, but the problem with cycling through a range and deleting is that you then skip the next cell in the range you are looping through when the Range re-adjusts and the cell after the cell you are on become the cell you are on so the next cell is the one after the cell after the one you just delete. (This also probably a more elegant way of saying that, which doesn't leave you scratching your head saying, wait... what did they just say?)

While you ponder if I ever graduate high school English class, lets go on to the next likely way you could be looping through: Because you appear to have a date in all fields you could simply have a Do Loop which continues until you find a blank date cell, in which case we can handle it this way.

Dim Row As Long
Row = 2
Do Until Range("A" & Row).Value = VBA.Constants.vbNullString
    If Range("B" & Row).Value = VBA.Constants.vbNullString Or Range("D" & Row).Value = VBA.Constants.vbNullString Then ' We have no name or Job
        Range(Row & ":" & Row).Delete
        Row = Row - 1
    Else
        [Code for formatting can go here]
    End If
    Row = Row + 1
Loop

Hopefully that helps with point one. Now, on to point two, the date. Dates in Excel are somewhat of a hard concept to understand, they are not stored as three components, day, month year, but as one component which is days. but it is number of day since 12/31/1899, that is, 1 = 1/1/1900 while 365 = 12/30/1900 (it was a leap year; it is actually stored as a double data type where the value after the decimal would be time of day, but we don't have to get into that part here). So when you provide Excel a string "8/3/2022" it has to try and convert it into a date based on your settings for dates. We could try and fiddle with your date settings or simply manipulate the strings ourselves (Can you guess which one I'm opting for?). Yup, you guessed it, manipulating it ourselves:

' presumably somewhere in our code we have defined a variable called Row and assigned the value of the row we are working on to it.
Dim DateArray() As String
DateArray = VBA.Strings.Split(Range("A" & Row).Value, ".")
Range("A" & Row).Value = DateSerial(DateArray(2), DateArray(1), DateArray(0)) ' *

Now you just have to format the cell to have the date appear the way you want it.
* In case you've set Option Base 1, you will need to update each number up one from this line.

The final implied question, how to input the SUM into the green cells? Assuming you can identify the cell in your code, then you can always use this rng.Formula = "=SUM(" & ColumnLetter & TopRow & ":" & ColumnLetter & BottomRow & ")".

I hope this helped, if you need more, please provide the existing code you are working.

 

[Rosen]

Here is the CommandButton1_Click event re-coded to fix the dates

Private Sub CommandButton1_Click()
    
    On Error Resume Next
    Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Columns("A").NumberFormat = "dd-mm-yy"
'Worksheets("SAP Data").Columns("A").Replace _
' What:=".", Replacement:="/", _
' SearchOrder:=xlByColumns, MatchCase:=True
    Dim Row As Long
    Row = 2
    Do Until Worksheets("SAP Data").Range("A" & Row).Value = VBA.Constants.vbNullString
        Dim DateArray() As String
        DateArray = VBA.Strings.Split(Worksheets("SAP Data").Range("A" & Row).Value, ".")
        Range("A" & Row).Value = DateSerial(DateArray(2), DateArray(1), DateArray(0))
        Row = Row + 1
    Loop
    Worksheets("SAP Data").Columns("C").Replace _
                   What:=",", Replacement:=".", _
                   SearchOrder:=xlByColumns, MatchCase:=True
End Sub

I will need to think on CommandButton2.

 

[Rosen]

This should do what you'd like, but it isn't well tested, remember to make a back up before running this code, not all formatting has been done, but the data goes where you wanted it to.

Private Sub CommandButton2_Click()

    Dim Row As Long
    Dim StartDt As Date
    Dim EndDt As Date
    Dim Entries As New Collection
    Dim Person As Collection
     
    StartDt = Range("A2").Value
    EndDt = Range("A2").Value
     
    For Row = 2 To Range("A2").End(xlDown).Row
     
        If Range("A" & Row).Value > EndDt Then EndDt = Range("A" & Row).Value
        If Range("A" & Row).Value < StartDt Then StartDt = Range("A" & Row).Value
        
        Dim Entry As Entry
        Set Entry = New Entry
        Entry.eDate = Range("A" & Row).Value
        Entry.eName = Range("B" & Row).Value
        Entry.eHours = Range("C" & Row).Value
        Entry.eJob = Range("D" & Row).Value
        
        On Error Resume Next
        Set Person = Entries(Entry.eName)
        If Err.Number <> 0 Then
            Set Person = New Collection
            Entries.Add Person, Entry.eName
        End If
        On Error GoTo 0
        Person.Add Entry
    Next Row
     
    Dim Sheet As Worksheet
    Dim Cell As Range
    Set Sheet = Worksheets.Add
    On Error Resume Next
    Sheet.Name = "Work Schedule"
    On Error GoTo 0
    Dim Column As Long
    For Column = StartDt To EndDt
        Set Cell = Sheet.Cells(1, (Column - StartDt + 1) * 2)
        Cell.Value = Column
        Cell.NumberFormat = "DD.MM.YYYY"
        Cell.Interior.Color = 65535
        Cell.Borders(xlEdgeLeft).Weight = xlMedium
        Cell.Borders(xlEdgeRight).Weight = xlMedium
        Cell.Borders(xlEdgeTop).Weight = xlMedium
        Cell.Borders(xlEdgeBottom).Weight = xlMedium
    Next
    
    Row = 0
    Dim StRow As Long, lRow As Long
    Dim E As Entry
    For Each Person In Entries
        Row = Row + 3
        StRow = Row
        Set E = Person.Item(1)
        Sheet.Range("A" & Row).Value = E.eName
        For Column = StartDt To EndDt
            Set Cell = Sheet.Cells(Row, (Column - StartDt + 1) * 2)
            For Each E In Person
                If E.eDate = Column Then
                    Cell.Value = E.eJob
                    Cell.Offset(, 1).Value = E.eHours
                    Set Cell = Cell.Offset(1)
                End If
            Next E
            If Cell.Row > lRow Then lRow = Cell.Row
        Next Column
        Dim Col As Long
        Dim ColLetter As String
        Dim Pos As Long
        For Column = StartDt To EndDt
            Col = (Column - StartDt + 1) * 2
            Set Cell = Sheet.Cells(1, Col + 1)
            ColLetter = Cell.Address
            ColLetter = VBA.Strings.Right(ColLetter, VBA.Strings.Len(ColLetter) - 1) ' remove first $
            Pos = VBA.Strings.InStr(1, ColLetter, "$")
            ColLetter = VBA.Strings.Left(ColLetter, Pos - 1)
            Sheet.Range(ColLetter & lRow).Formula = "=SUM(" & ColLetter & StRow & ":" & ColLetter & (lRow - 1) & ")"
            Sheet.Range(ColLetter & lRow).Interior.Color = RGB(180, 250, 180)
        Next Column
        Row = lRow - 1
    Next Person
End Sub

Hope this helps!

 

[HaydoC]

This should do what you'd like, but it isn't well tested, remember to make a back up before running this code, not all formatting has been done, but the data goes where you wanted it to.

Private Sub CommandButton2_Click()

    Dim Row As Long
    Dim StartDt As Date
    Dim EndDt As Date
    Dim Entries As New Collection
    Dim Person As Collection
    
    StartDt = Range("A2").Value
    EndDt = Range("A2").Value
    
    For Row = 2 To Range("A2").End(xlDown).Row
    
        If Range("A" & Row).Value > EndDt Then EndDt = Range("A" & Row).Value
        If Range("A" & Row).Value < StartDt Then StartDt = Range("A" & Row).Value
       
        Dim Entry As Entry
        Set Entry = New Entry
        Entry.eDate = Range("A" & Row).Value
        Entry.eName = Range("B" & Row).Value
        Entry.eHours = Range("C" & Row).Value
        Entry.eJob = Range("D" & Row).Value
       
        On Error Resume Next
        Set Person = Entries(Entry.eName)
        If Err.Number <> 0 Then
            Set Person = New Collection
            Entries.Add Person, Entry.eName
        End If
        On Error GoTo 0
        Person.Add Entry
    Next Row
    
    Dim Sheet As Worksheet
    Dim Cell As Range
    Set Sheet = Worksheets.Add
    On Error Resume Next
    Sheet.Name = "Work Schedule"
    On Error GoTo 0
    Dim Column As Long
    For Column = StartDt To EndDt
        Set Cell = Sheet.Cells(1, (Column - StartDt + 1) * 2)
        Cell.Value = Column
        Cell.NumberFormat = "DD.MM.YYYY"
        Cell.Interior.Color = 65535
        Cell.Borders(xlEdgeLeft).Weight = xlMedium
        Cell.Borders(xlEdgeRight).Weight = xlMedium
        Cell.Borders(xlEdgeTop).Weight = xlMedium
        Cell.Borders(xlEdgeBottom).Weight = xlMedium
    Next
   
    Row = 0
    Dim StRow As Long, lRow As Long
    Dim E As Entry
    For Each Person In Entries
        Row = Row + 3
        StRow = Row
        Set E = Person.Item(1)
        Sheet.Range("A" & Row).Value = E.eName
        For Column = StartDt To EndDt
            Set Cell = Sheet.Cells(Row, (Column - StartDt + 1) * 2)
            For Each E In Person
                If E.eDate = Column Then
                    Cell.Value = E.eJob
                    Cell.Offset(, 1).Value = E.eHours
                    Set Cell = Cell.Offset(1)
                End If
            Next E
            If Cell.Row > lRow Then lRow = Cell.Row
        Next Column
        Dim Col As Long
        Dim ColLetter As String
        Dim Pos As Long
        For Column = StartDt To EndDt
            Col = (Column - StartDt + 1) * 2
            Set Cell = Sheet.Cells(1, Col + 1)
            ColLetter = Cell.Address
            ColLetter = VBA.Strings.Right(ColLetter, VBA.Strings.Len(ColLetter) - 1) ' remove first $
            Pos = VBA.Strings.InStr(1, ColLetter, "$")
            ColLetter = VBA.Strings.Left(ColLetter, Pos - 1)
            Sheet.Range(ColLetter & lRow).Formula = "=SUM(" & ColLetter & StRow & ":" & ColLetter & (lRow - 1) & ")"
            Sheet.Range(ColLetter & lRow).Interior.Color = RGB(180, 250, 180)
        Next Column
        Row = lRow - 1
    Next Person
End Sub

Hope this helps!

Thank you for the reply. I am trying to give it a go to test it but I am getting a "Compile Error: User defined type not defined" and it is referring to the start of the macro for the second command button where you have "Dim Entry as Entry". I have tried to find a solution online to this but I again am not having much luck sorry. Do you have any suggestions?

 

[Rosen]

Thank you for the reply. I am trying to give it a go to test it but I am getting a "Compile Error: User defined type not defined" and it is referring to the start of the macro for the second command button where you have "Dim Entry as Entry". I have tried to find a solution online to this but I again am not having much luck sorry. Do you have any suggestions?

Sorry, forgot to mention I created a Class Module called Entry which contained four fields

Public eDate As Date
Public eName As String
Public eHours As Double
Public eJob As String