Calculate COUNT of consecutive values in a column with Excel VBA

Question

I have the below data in an excel spreadsheet

I want to cycle through column B and capture consecutive Paid Leaves for each employee and generate a another aggregated table like the below one:

So for each employee to calculate the days of consecutive Paid Leaves in an extra row together with a Start and an End date (Start the first day and End the last day of the consecutive Leave).

I haven't managed to think of a way to tackle that. I have minimum experience in VBA and this logic seems very complex to my knowledge so far. I would appreciate if anyone could help.

Answer 1

This was getting too long for a comment so here's to help you on your way: We try not to just make things for others without OP even trying to code anything. To get into VBA, try out things with the macro reader, then read up on How to avoid using Select in Excel VBA and perhaps start off with https://www.simplilearn.com/tutorials/excel-tutorial/excel-vba so you understand a bit what everything does/is for. As for logic getting from initial to end state:

• declare and set your workbook(s) and worksheets
• Currentrow = 1 (or wherever you want to start from)
• go from 1 to Lastrow through your B-column with for-loop (For i = Currentrow to Lastrow)
• if Range("B" & i).Value2 = "Paid Leave"
• Stuff i in a different variable to store your startRow (if multiple days off work)
• Same but in your endrow variable (this will come in handy later)
• Then use a while loop to check if the next row has Paid leave as well and adjust your endrow accordingly
• In the same while loop adjust Currentrow to Currentrow + 1 (for each row the next is paid leave, you need to increase your step in the for loop)
• amtDays = amtDays+1 (end of while loop)
• still in that If statement btw:
• get your lastrow of different sheet (lastrow2) and then fill out the values with the help of your variables, i.e. Start Date column would get wbOther.wsOther.Range("D" & lastrow2 + 1).Value2 = wbStart.wsStart.Range("A" & startRow).Value2
• amtDays = 1 (end of if)
• sort on date (you can do this in your other sheet at the end)

Then if you're still stuck after trying all this, come back and we'll be happy to help :)

EDIT After seeing you actually tried out something, here's my revised version of it with (hopefully) understandable commentary, I've used similar code like this before and I don't know anymore why I opted for a for-loop instead of a while but either could work in this case.

Sub paid_leave()
    Dim wb As Workbook 'declare all your variables upfront and go through your code with F8 from the VBE (VB environment)
    Dim ws As Worksheet, ws2 As Worksheet
    Dim CurrentRow As Long, Lastrow As Long, Lastrow2 As Long, amtDays As Long, i As Long
    
    Set wb = ActiveWorkbook
    Set ws = wb.Sheets("Blad1") 'a lot easier to write the rest of the code with
    Set ws2 = wb.Sheets("Blad2") 'and it helps when you need the change the name of the sheet/workbook
    CurrentRow = 2
    
    Lastrow = ws.Range("B" & Rows.Count).End(xlUp).Row
    amtDays = 1
    For i = CurrentRow To Lastrow 'could technically work with a while loop since we're not using the i and increment our CurrentRow as well
        If ws.Range("B" & CurrentRow).Value2 = "Paid Leave" Then
            Lastrow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
            ws2.Range("A" & Lastrow2 + 1).Value2 = ws.Range("C" & CurrentRow).Value2 'start and endrow not necessary this way
            ws2.Range("B" & Lastrow2 + 1).Value2 = ws.Range("B" & CurrentRow).Value2
            ws2.Range("D" & Lastrow2 + 1).Value2 = ws.Range("A" & CurrentRow).Value2
            'Do While CurrentRow <> Lastrow 'this is a bad condition, we're already going through all the rows with the for loop, base it on the criteria we want to keep finding aka "Paid Leave"
            Do While ws.Range("B" & CurrentRow + 1).Value2 = "Paid Leave" 'if it's only one day, CurrentRow and amtDays remain on values where it started
                CurrentRow = CurrentRow + 1
                amtDays = amtDays + 1
            Loop
            ws2.Range("C" & Lastrow2 + 1).Value2 = amtDays
            ws2.Range("E" & Lastrow2 + 1).Value2 = ws.Range("A" & CurrentRow).Value2
            amtDays = 1
        End If
        CurrentRow = CurrentRow + 1
        If CurrentRow > Lastrow Then Exit For 'no need to go further (with a while loop this isn't necessary anymore)
    Next i
End Sub

If you have any further questions, feel free to ask them (properly ;))

Answer 2

This can also be accomplished using Power Query, available in Windows Excel 2010+ and Excel 365 (Windows or Mac)

To use Power Query

• Select some cell in your Data Table
• Data => Get&Transform => from Table/Range or from within sheet
• When the PQ Editor opens: Home => Advanced Editor
• Make note of the Table Name in Line 2
• Paste the M Code below in place of what you see
• Change the Table name in line 2 back to what was generated originally.
• Read the comments and explore the Applied Steps to understand the algorithm

let

//Change Name in next line to reflect actual data source
    Source = Excel.CurrentWorkbook(){[Name="Table5"]}[Content],

//Set the data types
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Date", type date}, {"Status", type text}, {"Name", type text}}),

//Group by status and Name with "GroupKind.Local" argument
    #"Grouped Rows" = Table.Group(#"Changed Type", {"Status", "Name"}, {
        {"Days", each Table.RowCount(_), Int64.Type}, 
        {"Start Date", each List.Min([Date]), type nullable date}, 
        {"End Date", each List.Max([Date]), type nullable date}},
        GroupKind.Local),

//Select only "Paid Leave" in the Status column
    #"Filtered Rows" = Table.SelectRows(#"Grouped Rows", each ([Status] = "Paid Leave"))
in
    #"Filtered Rows"

Note: Most of this can be done in the User Interface. However, the default type for the Date column needs to be changed from datetime to date, and the GroupKind.Local argument needs to be added manually

Answer 3

Editing the code and adding another approach since I have worked it out a little more before Notus_Panda's final answer!! Thanks a lot again.

Sub paid_leave()
Dim wb As Workbook
Dim sh, sh2 As Worksheet

Set wb = ActiveWorkbook
Set sh = wb.Sheets("Sheet1")
Set sh2 = wb.Sheets("Sheet2")

Currentrow = 2
i = 2
lastrow = wb.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
amtDays = 1

Do While i <= lastrow
    If wb.Sheets("Sheet1").Range("B" & i).Value2 = "Paid Leave" Then
        startRow = i
        endrow = i
        Do While wb.Sheets("Sheet1").Range("B" & i + 1).Value2 = "Paid Leave"
                endrow = endrow + 1
                amtDays = amtDays + 1
                i = i + 1
        Loop
        lastrow2 = wb.Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
        wb.Sheets("Sheet2").Range("A" & lastrow2 + 1).Value2 = wb.Sheets("Sheet1").Range("C" & startRow).Value2
        wb.Sheets("Sheet2").Range("B" & lastrow2 + 1).Value2 = wb.Sheets("Sheet1").Range("B" & startRow).Value2
        wb.Sheets("Sheet2").Range("C" & lastrow2 + 1).Value2 = amtDays
        wb.Sheets("Sheet2").Range("D" & lastrow2 + 1).Value2 = wb.Sheets("Sheet1").Range("A" & startRow).Value2
        wb.Sheets("Sheet2").Range("E" & lastrow2 + 1).Value2 = wb.Sheets("Sheet1").Range("A" & endrow).Value2
        amtDays = 1
        i = i + 1
    End If
    i = i + 1
Loop
End Sub