Find duplicates in a column and add their corresponding values from another column

Question

I have column A with staff ids and hours worked in column K.

I would like if a staff id appears more than once to add hours worked and put the result in another colu

Answer 1

Try below code :

Sub sample()

    Dim lastRow As Integer, num As Integer, i As Integer
    lastRow = Range("A65000").End(xlUp).Row


    For i = 2 To lastRow
        num = WorksheetFunction.Match(Cells(i, 1), Range("A1:A" & lastRow), 0)

        If i = num Then
            Cells(i, 3) = WorksheetFunction.SumIf(Range("A1:A" & lastRow), Cells(i, 1), Range("B1:B" & lastRow))
        Else
            Cells(i, 1).Interior.Color = vbYellow
        End If
    Next

End Sub

BEFORE

AFTER

Answer 2

Sub SelectColoredCells()
    Dim rCell As Range
    Dim lColor As Long
    Dim rColored As Range

    'Select the color by name (8 possible)
    'vbBlack, vbBlue, vbGreen, vbCyan,
    'vbRed, vbMagenta, vbYellow, vbWhite
    lColor = RGB(156, 0, 6)

    'If you prefer, you can use the RGB function
    'to specify a color
    'Default was lColor = vbBlue
    'lColor = RGB(0, 0, 255)

    Set rColored = Nothing
    For Each rCell In Selection
        If rCell.Interior.Color = lColor Then
            If rColored Is Nothing Then
                Set rColored = rCell
            Else
                Set rColored = Union(rColored, rCell)
            End If
        End If
    Next
    If rColored Is Nothing Then
        MsgBox "No cells match the color"
    Else
        rColored.Select
        MsgBox "Selected cells match the color:" & _
            vbCrLf & rColored.Address
    End If
    Set rCell = Nothing
    Set rColored = Nothing
End Sub

this highlights the duplicates

Answer 3

Here is the solution for the data table located in range A1:B10 with headers and results written to column C.

Sub Solution()

Range("c2:c10").Clear

Dim i
For i = 2 To 10

    If WorksheetFunction.SumIf(Range("A1:a10"), Cells(i, 1), Range("C1:C10")) = 0 Then

        Cells(i, "c") = WorksheetFunction.SumIf( _
                         Range("A1:a10"), Cells(i, 1), Range("B1:B10"))
    Else
        Cells(i, "c") = 0
    End If
Next i

End Sub

Answer 4

Below code identifies duplicate value in a column and highlight with red. Hope this might be of some help.

  iLastRow = Cells(chosenExcelSheet.Rows.Count, 1).End(xlUp).Row 'Determine the last row to look at     
    Set rangeLocation = Range("A1:A" & iLastRow)

    'Checking if duplicate values exists in same column
        For Each myCell In rangeLocation
            If WorksheetFunction.CountIf(rangeLocation, myCell.Value) > 1 Then
                myCell.Interior.ColorIndex = 3'Highlight with red Color
            Else
                myCell.Interior.ColorIndex = 2'Retain white Color
            End If
        Next

Answer 5

As everyone else said, a Pivot Table really is the best way. If you're unsure how to use a PivotTable or what it's good for, refer to this SO post where I explain in detail.

Anyway, I put together the below VBA function to help get you started. It's by no means the most efficient approach; it also makes the following assumptions:

• Sheet 1 has all the data
• A has Staff Id
• B has Hours
• C is reserved for Total Hours
• D will be available for processing status output

This of course can all be changed very easily by altering the code a bit. Review the code, it's commented for you to understand.

The reason a Status column must exist is to avoid processing a Staff Id that was already processed. You could very alter the code to avoid the need for this column, but this is the way I went about things.

CODE

Public Sub HoursForEmployeeById()

    Dim currentStaffId As String
    Dim totalHours As Double

    Dim totalStaffRows As Integer
    Dim currentStaffRow As Integer
    Dim totalSearchRows As Integer
    Dim currentSearchRow As Integer

    Dim staffColumn As Integer
    Dim hoursColumn As Integer
    Dim totalHoursColumn As Integer
    Dim statusColumn As Integer

    'change these to appropriate columns
    staffColumn = 1
    hoursColumn = 2
    totalHoursColumn = 3
    statusColumn = 4

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    totalStaffRows = Sheet1.Cells(Rows.Count, staffColumn).End(xlUp).Row
    For currentStaffRow = 2 To totalStaffRows
        currentStaffId = Cells(currentStaffRow, staffColumn).Value

        'if the current staff Id was not already processed (duplicate record)
        If Not StrComp("Duplicate", Cells(currentStaffRow, statusColumn).Value, vbTextCompare) = 0 Then
            'get this rows total hours
            totalHours = CDbl(Cells(currentStaffRow, hoursColumn).Value)
            'search all subsequent rows for duplicates
            totalSearchRows = totalStaffRows - currentStaffRow + 1
            For currentSearchRow = currentStaffRow + 1 To totalSearchRows
                If StrComp(currentStaffId, Cells(currentSearchRow, staffColumn), vbTextCompare) = 0 Then
                    'duplicate found: log the hours worked, set them to 0, then mark as Duplicate
                    totalHours = totalHours + CDbl(Cells(currentSearchRow, hoursColumn).Value)
                    Cells(currentSearchRow, hoursColumn).Value = 0
                    Cells(currentSearchRow, statusColumn).Value = "Duplicate"
                End If
            Next
            'output total hours worked and mark as Processed
            Cells(currentStaffRow, totalHoursColumn).Value = totalHours
            Cells(currentStaffRow, statusColumn).Value = "Processed"
            totalHours = 0  'reset total hours worked
        End If
    Next
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationAutomatic

End Sub

BEFORE

AFTER