Duplicates and Combining multiple cells into 1 cell

[Patriot2879]

Hi please can you help me? i have the code below where the first part works where it removes the duplicates. But with the cells left over with data i am trying to combine these into 1 cell, but this is not working. Please can you help? This is the snippet of code where i am trying to combine the data from the cells into one

Range("A6").cell.Value = Range("A1").cell.Value & Range("B1").cell.Value & Range("C1").cell.Value & Range("D1").cell.Value & Range("E1").cell.Value

The below is the whole code.

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim cell As Range
    Dim duplicate As Boolean
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet's name
    
    ' Loop through each cell in the range A1 to E1
    For Each cell In ws.Range("A1:E1")
        duplicate = False ' Reset duplicate flag for each cell
        
        ' Check if the current cell is not empty
        If cell.Value <> "" Then
            ' Loop through each cell in the same row
            For Each c In ws.Range(cell.Offset(0, 1), cell.Offset(0, 4))
                ' Check if the value matches with any other cell in the row
                If c.Value = cell.Value Then
                    duplicate = True ' Flag as duplicate
                    Exit For ' Exit the loop once a duplicate is found
                End If
            Next c
            
            ' If duplicate found, clear the current cell
            If duplicate Then cell.ClearContents
        End If
    Next cell
    
    Range("A6").cell.Value = Range("A1").cell.Value & Range("B1").cell.Value & Range("C1").cell.Value & Range("D1").cell.Value & Range("E1").cell.Value
  
End Sub

 

[Scott Huish]

Can you possibly post a sample of your data with expected results?

 

[Patriot2879]

Can you possibly post a sample of your data with expected results?

HI I have attached a screenshot of what i want it to do, the red is where it is is before the button is clicked and the green is when the button is clicked. What i want is the 5 cells to be put into one and all the duplicates words to be removed. after each word i want a '/' after to break it up. hope this info is ok and hope you can help me please?

 

[Scott Huish]

1 question. Why does your code reference Row 1 when you seem to have multiple rows of data?

 

[Patriot2879]

1 question. Why does your code reference Row 1 when you seem to have multiple rows of data?

Hi i have managed to amend my code to get it working, but it is a lot of code to repeat as i need to do this another 200 times, is there any way to combine it shorter?

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim cell As Range
    Dim duplicate As Boolean
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet2") ' Change "Sheet1" to your sheet's name
    
    ' Loop through each cell in the range A1 to E3
    For Each cell In ws.Range("B2:F3")
        duplicate = False ' Reset duplicate flag for each cell
        
        ' Check if the current cell is not empty
        If cell.Value <> "" Then
            ' Loop through each cell in the same row
            For Each c In ws.Range(cell.Offset(0, 1), cell.Offset(0, 4))
                ' Check if the value matches with any other cell in the row
                If c.Value = cell.Value Then
                    duplicate = True ' Flag as duplicate
                    Exit For ' Exit the loop once a duplicate is found
                End If
            Next c
            
            ' If duplicate found, clear the current cell
            If duplicate Then cell.ClearContents
        End If
    Next cell
    ' Define variables for each cell value
    Dim valueB As String
    Dim valueC As String
    Dim valueD As String
    Dim valueE As String
    Dim valueF As String
    
    ' Store values from Sheet2, cells A3 to E3 into variables
    With Worksheets("Sheet2")
        valueB = .Range("B2").Value
        valueC = .Range("C2").Value
        valueD = .Range("D2").Value
        valueE = .Range("E2").Value
        valueF = .Range("F2").Value

    
   ' Initialize concatenatedValue as empty string
    Dim concatenatedValue As String
    concatenatedValue = ""
    
    ' Check each value and concatenate with "/" if not empty
    If valueB <> "" Then
        concatenatedValue = valueB
    End If
    
    If valueC <> "" Then
        If concatenatedValue <> "" Then
            concatenatedValue = concatenatedValue & " / " & valueC
        Else
            concatenatedValue = valueC
        End If
    End If
    
    If valueD <> "" Then
        If concatenatedValue <> "" Then
            concatenatedValue = concatenatedValue & " / " & valueD
        Else
            concatenatedValue = valueD
        End If
    End If
    
    If valueE <> "" Then
        If concatenatedValue <> "" Then
            concatenatedValue = concatenatedValue & " / " & valueE
        Else
            concatenatedValue = valueE
        End If
    End If
    
    If valueF <> "" Then
        If concatenatedValue <> "" Then
            concatenatedValue = concatenatedValue & " / " & valueF
        Else
            concatenatedValue = valueF
        End If
    End If
    ' Put the concatenated value into cell A4 on Sheet1
    Worksheets("Sheet1").Range("B2").Value = concatenatedValue
    
    ' Store values from Sheet2, cells A3 to E3 into variables
    With Worksheets("Sheet2")
        valueB = .Range("B3").Value
        valueC = .Range("C3").Value
        valueD = .Range("D3").Value
        valueE = .Range("E3").Value
        valueF = .Range("F3").Value
    End With
   ' Initialize concatenatedValue as empty string
    concatenatedValue = ""
    
    ' Check each value and concatenate with "/" if not empty
    If valueB <> "" Then
        concatenatedValue = valueB
    End If
    
    If valueC <> "" Then
        If concatenatedValue <> "" Then
            concatenatedValue = concatenatedValue & " / " & valueC
        Else
            concatenatedValue = valueC
        End If
    End If
    
    If valueD <> "" Then
        If concatenatedValue <> "" Then
            concatenatedValue = concatenatedValue & " / " & valueD
        Else
            concatenatedValue = valueD
        End If
    End If
    
    If valueE <> "" Then
        If concatenatedValue <> "" Then
            concatenatedValue = concatenatedValue & " / " & valueE
        Else
            concatenatedValue = valueE
        End If
    End If
    
    If valueF <> "" Then
        If concatenatedValue <> "" Then
            concatenatedValue = concatenatedValue & " / " & valueF
        Else
            concatenatedValue = valueF
        End If
    End If
    ' Put the concatenated value into cell A4 on Sheet1
    Worksheets("Sheet1").Range("B3").Value = concatenatedValue
        End With
End Sub

 

[Scott Huish]

Probably, but I need to know how your data actually looks. Your code samples have mentioned several ranges now. Your sample shows data on A3, A6, etc. Is your data actually separated 3 rows apart?
Your second code seems to indicate 1 row apart? Is this correct, and if so do we need to insert a row to accommodate the combined values as you have indicated in green?

 

[Patriot2879]

Probably, but I need to know how your data actually looks. Your code samples have mentioned several ranges now. Your sample shows data on A3, A6, etc. Is your data actually separated 3 rows apart?
Your second code seems to indicate 1 row apart? Is this correct, and if so do we need to insert a row to accommodate the combined values as you have indicated in green?

Hi i have attached another 2 images of how it is to look, i have my data to pull from in sheet2, so when button is pressed it removed the duplicates and puts all the data into once cell into sheet1 alongside the correct name. hope this helps? and that you can help please to make the code smaller thank you