CODEWITHSUNDEEP
vbaexcel
Cassy
Cassy

Reputation: 1

If date in one column is the same, then sum the values in another column

I am fairly new at VBA and I am currently trying to rework an existing macro that sums hours of a workday up by employee for the week.

I need a macro that will sum up the work hours by just a single day instead of a weekly total. There are two entries per day for each employee. Then, this total is copy and pasted into a different column.

I can not use a pivot table as this macro will be used on a different spreadsheet every week. I also can not have a reference sheet. This is going to be applied to a spreadsheet that is emailed every week, so it is constantly changing.

Basically... if the date in Column B is the same, I need the sum of hours in Column C, then that Sum is pasted over to a new column (D is fine).

Below is what the original report looks like at this point:

  A               B         C
Joe Smith  --  03/26/2018 -- 3.65
Joe Smith  --  03/26/2018 -- 4.46
Joe Smith  --  03/27/2018 --  5.45
Joe Smith  --  03/27/2018 --  2.93

The existing macro is :

For Each x In n.Range(n.Range("B2"), n.Range("B" & Rows.Count).End(xlUp))
    x.Value = Month(x.Value) & "/" & Day(x.Value) & "/" & Year(x.Value)
Next x
For Each x In n.Range(n.Range("J2"), n.Range("J" & Rows.Count).End(xlUp))
    Set r = n.Range(x.Address)
    r.Offset(0, 1).Value = 
    Format(Application.WorksheetFunction.Max(n.Range(n.Range("B2"), n.Range ("B" & Rows.Count).End(xlUp))), "MM/DD/YYYY")
    r.Offset(0, 2).Value = Application.WorksheetFunction.SumIf(n.Range("A:A"), x.Value, n.Range("E:E"))
    For I = 3 To UBound(TableHeaders)
        ch = TableHeaders(I)
        r.Offset(0, I).Value = Application.WorksheetFunction.SumIfs(a.Range("R:R"), 
        a.Range("L:L"), ch, a.Range("A:A"), x.Value)
    Next I

    d.RemoveAll
Next x

Upvotes: 0

Views: 689

Answers (2)

Dick Kusleika
Dick Kusleika

Reputation: 33145

Here's an all code way. You'll have to adjust the code to find the range you want to read and also figure out where to write to.

Sub SumEeDays()

    Dim vaValues As Variant
    Dim i As Long
    Dim dc As Scripting.Dictionary
    Dim sKey As String

    'set a reference to the MS Scripting Runtime
    'then you wont get an error on this line
    Set dc = New Scripting.Dictionary

    'Make a 2d array of the values you want process
    vaValues = Sheet1.Range("a1").CurrentRegion.Value

    'loop through the 2d array
    For i = LBound(vaValues, 1) To UBound(vaValues, 1)
        'create a unique key to keep track of ee name and date
        sKey = vaValues(i, 1) & "||" & vaValues(i, 2)

        If dc.Exists(sKey) Then
            'If the key already exists, add the hours to what's there
            dc.Item(sKey) = dc.Item(sKey) + vaValues(i, 3)
        Else
            'If the key doesn't exist, create it and add the hours
            dc.Add sKey, vaValues(i, 3)
        End If
    Next i

    'Loop through the dictionary of unique name/dates
    For i = 1 To dc.Count
        With Sheet1.Range("J1")
            'Keys returns an array and Split splits it on "||"
            'The 0th element of the array is the name
            'The 1st element is the date
            .Offset(i - 1, 0).Value = Split(dc.Keys(i - 1), "||")(0)
            .Offset(i - 1, 1).Value = Split(dc.Keys(i - 1), "||")(1)
            .Offset(i - 1, 2).Value = dc.Items(i - 1)
        End With
    Next i

End Sub

Upvotes: 0

MarcinSzaleniec
MarcinSzaleniec

Reputation: 2256

I can not use a pivot table as this macro will be used on a different spreadsheet every week.

well, this is not a reason. You could run change source for pivot table any time.

This is going to be applied to a spreadsheet that is emailed every week

But at least layout of the workbooks is preserved? The simplest way is to use formula:

=SUMIFS(C:C, A:A, A2, B:B, B2)

Paste it to D2 and drag down. You could also put formulas to A:C that just refers to proper values in source file, like:

=[WorkbookFromEmail.xlsx]Sheet1!A2

and drag it left to C and down to as many rows as you think you will need and some more. Then you could only change the name of linked file in Data/Edit Links. As far, you don't need VBA. But you could make some macro for refreshing links to other workbook if you found manual job too troubling. This is however different story. Alternatively, you could save the source file always under the same name, like BookFromMail.xlsx and then open the master file with formulas and refresh it.

Upvotes: 0

Related Questions