Page 2 of 3 FirstFirst 1 2 3 LastLast
Results 11 to 20 of 25

Thread: Merge Two columns based on date

  1. #11
    Acolyte Nick Burns's Avatar
    Join Date
    May 2017
    Posts
    75
    Articles
    0
    Excel Version
    Office 365


    Register for a FREE account, and/
    or Log in to avoid these ads!

    Just top three:
    1) Missing Option Explicit (this helps with issue 2)
    2) Not all variables defined
    3) Use of .Select is unnecessary.
    Oh... by the way, YOU'RE WELCOME!

  2. #12
    Administrator AliGW's Avatar
    Join Date
    Nov 2015
    Location
    Ipswich, Suffolk, England
    Posts
    1,270
    Articles
    0
    Excel Version
    Office 365 Subscription
    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.
    Ali
    Enthusiastic self-taught user of MS Excel!

  3. #13
    Acolyte Nick Burns's Avatar
    Join Date
    May 2017
    Posts
    75
    Articles
    0
    Excel Version
    Office 365
    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.
    Oh... by the way, YOU'RE WELCOME!

  4. #14
    Administrator AliGW's Avatar
    Join Date
    Nov 2015
    Location
    Ipswich, Suffolk, England
    Posts
    1,270
    Articles
    0
    Excel Version
    Office 365 Subscription
    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.
    Ali
    Enthusiastic self-taught user of MS Excel!

  5. #15
    Acolyte horseyride's Avatar
    Join Date
    Nov 2017
    Posts
    92
    Articles
    0
    Excel Version
    Office 365 Pro Plus 1708.8431.
    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"

  6. #16
    Acolyte Nick Burns's Avatar
    Join Date
    May 2017
    Posts
    75
    Articles
    0
    Excel Version
    Office 365
    Quote Originally Posted by AliGW View Post
    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.
    Oh... by the way, YOU'RE WELCOME!

  7. #17
    Administrator AliGW's Avatar
    Join Date
    Nov 2015
    Location
    Ipswich, Suffolk, England
    Posts
    1,270
    Articles
    0
    Excel Version
    Office 365 Subscription
    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.
    Ali
    Enthusiastic self-taught user of MS Excel!

  8. #18
    Acolyte Nick Burns's Avatar
    Join Date
    May 2017
    Posts
    75
    Articles
    0
    Excel Version
    Office 365
    Quote Originally Posted by AliGW View Post
    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.
    Quote Originally Posted by AliGW View Post
    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
    No hard feelings?
    Oh... by the way, YOU'RE WELCOME!

  9. #19
    Administrator AliGW's Avatar
    Join Date
    Nov 2015
    Location
    Ipswich, Suffolk, England
    Posts
    1,270
    Articles
    0
    Excel Version
    Office 365 Subscription
    Thanks for doing this - very helpful.
    Ali
    Enthusiastic self-taught user of MS Excel!

  10. #20
    Acolyte NormS's Avatar
    Join Date
    Jul 2017
    Posts
    26
    Articles
    0
    Excel Version
    Excel 2016 ProPlus
    And belated thanks to horseyride for the Power Query solution.

Page 2 of 3 FirstFirst 1 2 3 LastLast

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •