Merge Two columns based on date

mmoore5553

New member
Joined
Mar 8, 2019
Messages
19
Reaction score
0
Points
0
Excel Version(s)
office 365 excel
I have a power query which it is basically a time clock.

I have a date and user first name and last and time they clocked in and then clocked out. I need to combine the the two columns based on the date and the user first name and last name. See example below.

The final result would be

3/4/2019 megan cunningham 8:58 am 2:17 am 3:17 am 5:58 am
3/5/2019 megan cunningham 9:00 am 2:32 am 3:37 am 6:14 am

This would be done for each date .

it is basically merging any other column that matches the same date and same username and adding the other times. I have tried to group by and then do a list but i could only bring in one value. Any help would be appreciated. I can share the excel sheet if needed. excel_help.PNG
 
Pictures
Will you please attach a sample Excel workbook? We are not able to work with or manipulate a picture of one and nobody wants to have to recreate your data from scratch.


1. Make sure that your sample data are REPRESENTATIVE of your real data. The use of unrepresentative data is very frustrating and can lead to long delays in reaching a solution.


2. Make sure that your desired results are also shown (mock up the results manually).


3. Make sure that all confidential data is removed or replaced with dummy data first (e.g. names, addresses, E-mails, etc.).


4. Try to avoid using merged cells as they cause lots of problems.


Please pay particular attention to point 2 (above): without an idea of your intended outcomes, it is often very difficult to offer appropriate advice.
 
Thank you alansidman. I have updated the spreadsheet with a results tab on how the data should look after it is done.
 

Attachments

  • Timecard report by Department.xlsx
    147.8 KB · Views: 30
Please disregard. I had to hire someone on freelancer.com to get it working.
 

Attachments

  • Timecard report by Department_v1.xlsm
    262.4 KB · Views: 25
Thanks - that's useful for others looking for similar solutions. :)

However, for anyone reading this, it's not a PowerQuery solution: it's VBA.
 
Though I'm sure the solution works, it's very novice type code.
 
On its own, that's a fairly useless observation, Nick. I hope you are going to go on show us what more expert code to do the same thing would look like and explain why. :)
 
Here's a Power Query solution. I grouped by employee and date, then used a trick I learned from Ken to assign an index to each group.

https://www.excelguru.ca/blog/2018/06/27/number-rows-by-group-using-power-query/

Merged the time in and time out into a single column and then pivoted this on the index. This revealed that some of the employees came and went as many as five times in a day. It wasn't clear how the OP wanted to handle this since she only shows two pairs in her desired results; it looks like the VB solution simply takes the first and last entry/exit on any given day.

Turns out that, after pivoting, there were 5 columns that needed unmerging. I did them one-by-one, but is there a more elegant way to do this that would future-proof the solution in case more or less columns resulted from the pivot operation?

View attachment Timecard report by Department PQ3.xlsx

Norm
 
Just top three:
1) Missing Option Explicit (this helps with issue 2)
2) Not all variables defined
3) Use of .Select is unnecessary.
 
Which again tells those of us with little VBA experience very much of any use.

Unless you are prepared to share your superior version of the VBA code for all to benefit from, there really is little point in commenting any further, as what you are saying isn’t detailed enough to be constructive.
 
I don’t know why this rubbed you the wrong way, but I apologize if it offended you.

My point is the original poster stated they paid a person at freelancer.com a website that touts expert service. I don’t know how much the OP paid, but that isn’t “expert” code (yes, in my opinion), yes it gets the job done but it could break, leaving the OP having to go back to the freelancer to fix what should have been done the first time.

I’m not saying I’m an expert in VBA, but I know that code isn’t very solid.

I’m still learning PowerQuery and would have attempted this in PQ before I resorted to VBA, which I actually started to do in PQ but it was late here so I had set it aside.

In retrospect, I do agree with you that my comment didn’t lend anything to the conversation. It was just my opinion that it didn’t seem to be expert service.
 
It didn't rub me up the wrong way. I was merely trying to elicit something useful from you. You are most likely right about the poor coding, but that doesn't really help the OP who has paid for it in good faith unless you can offer a better alternative.

Someone else has now offered a PQ solution on the previous page of this thread.
 
Following up for Norm,

Here's what I think is a slightly more elegant method of doing it, works for any number of columns

Code:
let Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
#"Removed Other Columns1" = Table.SelectColumns(Source,{"Worked Department", "Last Name", "First Name", "Employee", "Worked Department2", "State", "In time", "Out time"}),
#"Inserted Date" = Table.AddColumn(#"Removed Other Columns1", "Date", each DateTime.Date([In time]), type date),
#"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Inserted Date", {"State", "Worked Department2", "Employee", "First Name", "Last Name", "Worked Department","Date"}, "Attribute", "Value"),
#"Grouped Rows" = Table.Group(#"Unpivoted Other Columns", {"Employee", "Date"},  {{"Count", each Table.AddIndexColumn(_, "Index",1,1), type table}}),
#"Expanded Count1" = Table.ExpandTableColumn(#"Grouped Rows", "Count", {"Worked Department", "Last Name", "First Name", "Employee", "Worked Department2", "State", "Attribute", "Value", "Index"}, {"Worked Department", "Last Name", "First Name", "Employee.1", "Worked Department2", "State", "Attribute", "Value", "Index"}),
#"Changed Type1" = Table.TransformColumnTypes(#"Expanded Count1",{{"Value", type datetime}}),
#"Removed Columns" = Table.RemoveColumns(#"Changed Type1",{"Attribute"}),
#"Pivoted Column1" = Table.Pivot(Table.TransformColumnTypes(#"Removed Columns", {{"Index", type text}}, "en-US"), List.Distinct(Table.TransformColumnTypes(#"Removed Columns", {{"Index", type text}}, "en-US")[Index]), "Index", "Value")
in #"Pivoted Column1"
 
It didn't rub me up the wrong way. I was merely trying to elicit something useful from you. You are most likely right about the poor coding, but that doesn't really help the OP who has paid for it in good faith unless you can offer a better alternative.

Someone else has now offered a PQ solution on the previous page of this thread.


Have you tried the VBA version? Did you know that it doesn't deal well with employees that worked more than two shifts on a given day as member NormS has pointed out? In fact it only keeps the first and last set of times. Anything in between is lost - is this the intention? If so, for some employees that's a lot of missed time worked.
Further collaboration with the original poster is needed as to how to deal with those situations. So no, I can't provide a VBA solution at this point.
 
Further collaboration with the original poster is needed as to how to deal with those situations.

Great - I shall look forward to your helping the OP to understand the issues you have pointed out.
 
You are most likely right about the poor coding, but that doesn't really help the OP who has paid for it in good faith unless you can offer a better alternative.
Great - I shall look forward to your helping the OP to understand the issues you have pointed out.


Fair enough... here's my version of the VBA code (sorta putting my money where my mouth is, so to speak ;) )


I built off of the original code, as the premise was good, but the execution was faulty:


  1. I added some rudimentary error checking
  2. The original code did not take the State into effect
  3. The original code also didn't sort the records to properly trap the time
  4. I added a progress indicator to let the user know that "something" was happening.
  5. Since my code adds extra Time In/Out columns, I put in a warning that these columns need to be removed before running the macro a second time. - I admit this is lazy programming rather than doing it in the code.


This output matches horseyride's Power Query solution. (Very nice, btw!)


Self-admission: I don't comment my code as much as I should!

I don't really know how long this took me to code as I poked at it throughout the day.


Code:
Option Explicit


Sub Data_consolidation()


Dim wb As Workbook
Dim wk_Timecard_report As Worksheet
Dim wk_Results As Worksheet
Dim rn_compare As Range
Dim rn_last_Timecard As Range
Dim rn_last_Result As Range
Dim rngTimeIn As Range
Dim rngProgress As Range
Dim i As Integer
Dim bSuccess As Boolean


On Error GoTo ProcessError


    Set wb = ActiveWorkbook
    
    bSuccess = SheetExists(wb, "Timecard report by Department")
    If bSuccess = False Then
        Err.Raise Number:=9999, Description:="Could not find: 'Timecard report by Department' sheet"
    End If
    
    bSuccess = SheetExists(wb, "Results")
    If bSuccess = False Then
        Err.Raise Number:=9999, Description:="Could not find: 'Results' sheet"
    End If
    
    With wb.Worksheets("Program")
        Set rngProgress = .Range("D11")
    End With
    
    Set wk_Timecard_report = wb.Worksheets("Timecard report by Department")
    Set wk_Results = wb.Worksheets("Results")
    
    If wk_Timecard_report.Range("A1") <> "Worked Department" Then
        Err.Raise Number:=9999, Description:="Could not find Header in " & wk_Timecard_report.Name
    End If
    
    With wk_Timecard_report
        Set rn_last_Timecard = .Cells(.Rows.Count, "A").End(xlUp)
    End With
    
    If rn_last_Timecard.Row = 1 Then
        Err.Raise Number:=9999, Description:="Could not find Data in " & wk_Timecard_report.Name
    End If
    
    wk_Results.Rows("2:100000").Clear
    
    wk_Timecard_report.Range("A2:H" & rn_last_Timecard.Row).Copy wk_Results.Range("A2")
    
    
    With wk_Results
        If .Range("K1").Value <> "Out Punch Type" Then
            Err.Raise Number:=9999, Description:="Please remove extra Time In/Out columns after Out Time 2 on " & .Name & " worksheet"
        End If
        Set rn_compare = .Range(.Range("O2"), .Cells(rn_last_Timecard.Row, "O"))
    End With


'Sort Data in proper order Worked Department(A),Last Name(A),First Name(A),Employee(A),State(D),In time(A)
    With wk_Results
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=Range("A2:A2634"), SortOn:=xlSortOnValues, Order:=xlAscending
        .Sort.SortFields.Add2 Key:=Range("B2:B2634"), SortOn:=xlSortOnValues, Order:=xlAscending
        .Sort.SortFields.Add2 Key:=Range("C2:C2634"), SortOn:=xlSortOnValues, Order:=xlAscending
        .Sort.SortFields.Add2 Key:=Range("F2:F2634"), SortOn:=xlSortOnValues, Order:=xlDescending
        .Sort.SortFields.Add2 Key:=Range("G2:G2634"), SortOn:=xlSortOnValues, Order:=xlAscending
        With .Sort
            .SetRange Range("A1:M2634")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With


    'Create Comparison String (Worked Department&Last Name&First Name&Employee&State&In time)


    rn_compare.FormulaR1C1 = _
            "=RC[-14]&RC[-13]&RC[-12]&RC[-11]&RC[-10]&RC[-9]&TEXT(RC[-8],""yyyymmdd"")"
    
    With wk_Results
        Set rn_last_Result = .Cells(.Rows.Count, "A").End(xlUp)
    End With
    
    Set rn_last_Result = rn_last_Result.Offset(1)
    i = 2
    
    'Start comparison
    With wk_Results
        Set rn_compare = .Range("O" & i)
        While i < rn_last_Result.Row
            rngProgress.Value = Format((i / rn_last_Result.Row), "0.00%") & " " & CStr(i) & "/" & CStr(rn_last_Result.Row)
            Set rn_compare = .Cells(i, rn_compare.Column)
            If rn_compare = rn_compare.Offset(1) Then
                Set rngTimeIn = .Cells(i, "I")
                Do While rngTimeIn <> "" 'Determine if new TimeIn/Out columns are needed
                    If .Cells(1, rngTimeIn.Column + 2) = "Out Punch Type" Then
                        .Range(rngTimeIn.Offset(0, 2), rngTimeIn.Offset(0, 3)).EntireColumn.Insert
                        .Cells(1, rngTimeIn.Column + 2) = "In Time #"
                        .Cells(1, rngTimeIn.Column + 3) = "Out Time #"
                    End If
                    Set rngTimeIn = rngTimeIn.Offset(0, 2)
                Loop
                .Range("G" & i + 1 & ":H" & i + 1).Copy rngTimeIn
        
                .Rows(i + 1).Delete
                i = i - 1
            End If
            
            i = i + 1
        
        Wend
    
        rn_compare.EntireColumn.Delete
    
    End With
    
    MsgBox "Transfer completed", vbInformation, "Status"
    
    bSuccess = True
ProcessExit:


    Exit Sub
    
ProcessError:
    bSuccess = False
    MsgBox Err.Description


End Sub


Function SheetExists(ByRef WkBk As Workbook, ByVal shtName As String) As Boolean
    Dim wsSheet As Worksheet
    SheetExists = False
    On Error Resume Next
        Set wsSheet = WkBk.Worksheets(shtName)
        If Err.Number = 0 Then SheetExists = True
    Set wsSheet = Nothing


End Function

:tea: No hard feelings?
 
And belated thanks to horseyride for the Power Query solution.
 
Back
Top