Duplicates and Combining multiple cells into 1 cell

Patriot2879

Well-known Member
Joined
Feb 1, 2018
Messages
1,259
Office Version
  1. 2010
Platform
  1. Windows
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
Code:
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.

VBA 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
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Can you possibly post a sample of your data with expected results?
 
Upvote 0
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?
 

Attachments

  • Untitled.jpg
    Untitled.jpg
    45.4 KB · Views: 14
Upvote 0
1 question. Why does your code reference Row 1 when you seem to have multiple rows of data?
 
Upvote 0
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?
VBA Code:
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
 
Upvote 0
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?
 
Upvote 0
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
 

Attachments

  • sheet1.jpg
    sheet1.jpg
    36 KB · Views: 13
  • sheet2.jpg
    sheet2.jpg
    141.7 KB · Views: 13
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top