VBA help for timesheet

[jmccall93]

I have to pull daily timesheets for approval and have to format the way it is in the 2nd screenshot. I got most of the VBA code down but cannot find the best way to move everyone's lunches to between the name groupings and delete/cut only the original lunch entry. I can't do it based on the same cells every time as the timesheets varies with people boing off/ number of jobs each person works, etc. Items are redacted for employee's and customer's sakes. That's the only reason for the black cells. My spreadsheet starts out ever more jumbled than the first screenshot. I just cleaned it up to make what I need to accomplish more readable. initially there are no gaps between the names, but I am not worried about that part, that's just inserting line groupings to space them out.

Any suggestions to streamline my process would be great.

 

[jmccall93]

I could really use help on this. I cannot figure out a consistent way to move the lunch lines and delete the line they were on originally. The times it takes to do everything manually is eating into my other tasks.

 

[Sektor]

Here's proposed solution. Data starts from column C. Procedure is named "CreateReport".
The code assumes that both rows with sensitive data and launch breaks always exist (if it's required, then the check can be added).

Option Explicit

Sub CreateReport()

  Dim rw&, x&, k&, j&, last_row&, start_row&, end_row&
  Dim dt As Date
  Dim colBreaks As Collection
  Dim colSensitive As Collection
 
  With Worksheets("Data")
   
    last_row = .Cells(.Rows.Count, "C").End(xlUp).Row
    rw = 1 '//Initial row
   
    While rw <= last_row
   
      start_row = rw
      dt = .Cells(start_row, "F")
      Set colBreaks = New Collection
      Set colSensitive = New Collection
     
      '// Calculate end row
      Do While True
        If .Cells(rw + 1, "F") < dt Then
          end_row = rw
          Exit Do
        End If
        rw = rw + 1
        dt = .Cells(rw, "F") '//Next date
      Loop
      '// Create two groups
      For j = start_row To end_row
        If .Cells(j, "H") = "Lunch Break" Then
          colBreaks.Add j
        Else
          colSensitive.Add j
        End If
      Next
      Call TransferData(colBreaks, colSensitive)
      Set colBreaks = Nothing: Set colSensitive = Nothing
      rw = rw + 1
    Wend
 
  End With
 
  MsgBox "Well done!", vbInformation

End Sub

Private Sub TransferData(colBreaks As Collection, colSensitive As Collection)

  Dim last_row&, start_row&, rw&, vRow As Variant
 
  With Worksheets("FINAL")
 
    last_row = .Cells(.Rows.Count, "G").End(xlUp).Row
    rw = IIf(last_row > 1, last_row + 1, 0) '// Make some room
   
    '// Output sensitive
    For Each vRow In colSensitive
      rw = rw + 1 '//Next row
      Worksheets("Data").Rows(vRow).Copy .Rows(rw)
    Next
    '// Sensitive summary
    With .Cells(rw + 1, "G")
      .FormulaR1C1 = "=SUM(R[-1]C:R[-" & colSensitive.Count & "]C)"
      .Borders(xlEdgeTop).Weight = XlBorderWeight.xlThin
    End With
   
    '// Output lunch breaks
    rw = rw + 2 '//Gap
    For Each vRow In colBreaks
      rw = rw + 1 '//Next row
      Worksheets("Data").Rows(vRow).Copy .Rows(rw)
    Next
    '// Launch breaks summary
    With .Cells(rw + 1, "G")
      .FormulaR1C1 = "=SUM(R[-1]C:R[-" & colSensitive.Count & "]C)"
      .Borders(xlEdgeTop).Weight = XlBorderWeight.xlThin
    End With
   
  End With
 
End Sub

 

[jmccall93]

Thanks, it works for the most part, but there are still some gaps. see my examples below. The first one is your coding, the second one is my manual manipulation. You can see some of the lunches are missing or not moved with the coding used.

 

[Sektor]

It'd be helpful if you'd upload to cloud original document you get (since I coded based on the structure on "Data" sheet).

 

[jmccall93]

It'd be helpful if you'd upload to cloud original document you get (since I coded based on the structure on "Data" sheet).

Here is the original raw spreadsheet before I remove columns and begin cleaning it up/resizing the columns. This version has more days on it due to being over the weekend so it has Friday, Saturday and Sunday if necessary. Most reports are single day for the weekdays.

 

[Sektor]

I'll come back to it later...

 

[Sektor]

You've got dates as "#######". Could you expand these columns?

 

[jmccall93]

Here you go. I hope this is better.

 

[jmccall93]

Bumping in the hopes of getting a response.