How to copy cell contents from multiple rows into one cell if 3 column values are the same within a worksheet?

Question

I am trying to clean an excel dataset provided to me using VBA in the most efficient way possible. I want to compare row values (# may vary) of 3 columns within a worksheet range, if the row values are the same for all 3 columns, then i want the values of the same rows but different columns copied into one cell.

Sample Set: red should be copied into one cell:

Expectation with black removed and red in one cell

Ultimate Want

Before/ After Expectation

Answer 1

In the future, SO questions should be about specific issues you are having, not a general question.

Here is a VBA function that will:

1. Go through each cell, until it finds an empty cell. We will assume once an empty cell is found we are at the end of your data set.
2. Check if any of the first three columns have changed their data from the previous cell. If they have, this is our new 'working row'. The row where we will consolidate your dataset into.
3. For each row, add its value from the data set column to the 'working row', unless it already exists in that row.
4. Once finished, go back and delete empty cells.

Here's the subroutine:

Sub clean_dataset()
    Dim sh As Worksheet
    Dim rw As Range
    Dim workingRow As Integer
    Dim col1Value As String
    Dim col2Value As String
    Dim col3Value As String
    Dim rowCount As Integer

    workingRow = 1


    'Iterate through all rows on the sheet.  Stop if we get to an empty row.
    Set sh = ActiveSheet
    For Each rw In sh.Rows

        ' Exit if we get to an emptry row.
        If sh.Cells(rw.Row, 1).Value = "" Then
            Exit For
        End If

        ' Check if our three columns to watch have changed value.  If they have, we should be in a new 'working row'
        If rw.Row > 1 Then
            If (Range("A" & rw.Row).Value <> Range("A" & rw.Row - 1).Value) Or (Range("B" & rw.Row).Value <> Range("B" & rw.Row - 1).Value) Or (Range("C" & rw.Row).Value <> Range("C" & rw.Row - 1).Value) Then
                workingRow = rw.Row
            End If
        End If


        ' Get the values in the current row from the dataset we are trying to consolidate.
        col1Value = Range("D" & rw.Row).Value
        col2Value = Range("E" & rw.Row).Value
        col3Value = Range("F" & rw.Row).Value


        ' Add the values to the working row cells, if they do not already exist
        If InStr(Range("D" & workingRow).Value, col1Value) = 0 Then
            Range("D" & workingRow) = Range("D" & workingRow).Value & vbLf & col1Value
        End If
        If InStr(Range("E" & workingRow).Value, col2Value) = 0 Then
            Range("E" & workingRow) = Range("E" & workingRow).Value & vbLf & col2Value
        End If
        If InStr(Range("F" & workingRow).Value, col3Value) = 0 Then
            Range("F" & workingRow) = Range("F" & workingRow).Value & vbLf & col3Value
        End If


        ' As long as we are not in the working row, delete the values
        If rw.Row <> workingRow Then
            Range("D" & rw.Row) = vbNullString
            Range("E" & rw.Row) = vbNullString
            Range("F" & rw.Row) = vbNullString
        End If

        rowCount = rw.Row

    Next rw
    ' End of for each




    ' Go back through, and delete any rows that do not have values in column D
    For iter = rowCount To 1 Step -1

        ' If all three columns are blank, delete the row.
        If Range("D" & iter).Value = vbNullString Then
            sh.Rows(iter).Delete
        End If

    Next

End Sub

Hope this helps.

Answer 2

After quite a bit of searching I was able to finally find this very applicable post as my issue is similar to the OP.

I'm working with three sheets where Sheet 1 is the source, Sheet 2 is a check sheet and Sheet 3 is where I would be pasting/cleaning up my data from Sheet 2.

In Sheet1, I copy the value in Col C and filter it in Sheet2 - Col C and for each company in Col J, I need to check the volume in Col K and if volume is >/= 1, the row needs to be copy/pasted into Sheet 3 while consolidating the corresponding unique values in each cell of the row and removing duplicates and summing the values in col K. The third sheet is the expected sheet. Thanks for your help if possible.