convert dates to weekdays and group data using VBA

[Sparky2015]

Hi, Sparky here, I currently extract data from a central database using a SQL Stored Query. The data extract contains thousands of timelines, each row represents a timeline. I would like to group the timelines by their timesheet number and show the day of the week the time was recorded for. The file uploaded contains sample before and after data. I would be delighted if using VBA, Sheet 1 could be used to produce Sheet 2.

Many Thanks
__________________________________________________________________

Mod edit : post moved to appropriate forum …​

 

[Chihiro]

I'd recommend going pivot table route with what you are looking for.

See attached for sample set up. Data converted to table, and added helper column for weekday.

Classic Pivot view, removed expand/collapse button, each Row headers set to repeat and removed subtotal.

You can just update the data table and refresh pivot table to update the summary.

 

[Marc L]

Hi !

Pivot table is the obvious way !

The next code not using a pivot table demonstrates
it's easier to learn how to use a pivot table than VBA !
After codeline #22, it's only to apply borders & color :​

Sub Demo()
            Application.ScreenUpdating = False
               R& = Sheet2.UsedRange.Rows.Count
            If R > 1 Then Sheet2.Rows("2:" & R).Delete
With Sheet1.Cells(1).CurrentRegion.Columns("A:E").Rows
          .AdvancedFilter xlFilterCopy, , Sheet2.[A1:E1], True
    With Sheet2.Cells(1).CurrentRegion.Columns("A:E").Rows
        ReDim CK$(2 To .Count), VA(1 To .Count - 1, 1 To 7)
          For R = 2 To .Count
          CK(R) = Join$(Application.Index(.Item(R - 1).Resize(2).Value, 2), "¤")
          Next
    End With
    For R = 2 To .Count
        With .Item(R)
                  L& = Application.Match(Join$(Application.Index(.Resize(2).Value, 1), "¤"), CK, 0)
                  C% = Weekday(.Cells(1)(1, 7).Value, vbMonday)
            VA(L, C) = VA(L, C) + .Cells(1)(1, 6).Value
        End With
    Next
End With
With Sheet2
            .[F2].Resize(UBound(VA), 7).Value = VA:  C = 0
    With .UsedRange.Rows
        For R = 2 To .Count
            With .Item(R)
              If .Cells(1).Value <> T$ Then T = .Cells(1).Value: C = C = 0
              If C Then .Interior.ColorIndex = 24
            End With
        Next
            .Borders.ColorIndex = xlAutomatic
    End With
            .Activate
End With
            Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Sparky2015]

I'd recommend going pivot table route with what you are looking for.

See attached for sample set up. Data converted to table, and added helper column for weekday.

Classic Pivot view, removed expand/collapse button, each Row headers set to repeat and removed subtotal.

You can just update the data table and refresh pivot table to update the summary.

Thanky so much, really usefull (Never thought of using "Classic")

 

[Sparky2015]

Hi !

Pivot table is the obvious way !

The next code not using a pivot table demonstrates
it's easier to learn how to use a pivot table than VBA !
After codeline #22, it's only to apply borders & color :​

Sub Demo()
            Application.ScreenUpdating = False
               R& = Sheet2.UsedRange.Rows.Count
            If R > 1 Then Sheet2.Rows("2:" & R).Delete
With Sheet1.Cells(1).CurrentRegion.Columns("A:E").Rows
          .AdvancedFilter xlFilterCopy, , Sheet2.[A1:E1], True
    With Sheet2.Cells(1).CurrentRegion.Columns("A:E").Rows
        ReDim CK$(2 To .Count), VA(1 To .Count - 1, 1 To 7)
          For R = 2 To .Count
          CK(R) = Join$(Application.Index(.Item(R - 1).Resize(2).Value, 2), "¤")
          Next
    End With
    For R = 2 To .Count
        With .Item(R)
                  L& = Application.Match(Join$(Application.Index(.Resize(2).Value, 1), "¤"), CK, 0)
                  C% = Weekday(.Cells(1)(1, 7).Value, vbMonday)
            VA(L, C) = VA(L, C) + .Cells(1)(1, 6).Value
        End With
    Next
End With
With Sheet2
            .[F2].Resize(UBound(VA), 7).Value = VA:  C = 0
    With .Cells(1).CurrentRegion.Rows
        For R = 2 To .Count
            With .Cells(R, 1)
                If .Value <> T$ Then T = .Value: C = C = 0
                If C Then .Resize(, 12).Interior.ColorIndex = 24
            End With
        Next
            .Borders.ColorIndex = xlAutomatic
    End With
            .Activate
End With
            Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

Many thanks, this is great!! all the best

 

[Marc L]

Thanks Sparky !

I just amend my demonstration code for a little optimization …

​