Excel VBA: find dupes, remove, add string

February 4, 2011 at 12:53:03
Specs: Windows XP
Hello! I have tried many different archive VBA solutions and have failed at tweaking existing code in Excel 2003. I will simplify as much as a I can.

If Col A finds duplicate values, take Col B and add the strings together with a comma in between, then Delete the original duplicate cell. Sounds easy, but it's not.

Start With :
1 apple
1 pear
1 grape
2 orange
2 apple
3 pear
3 grape
4 apple

Expected Result:

1 apple, pear, grape
2 orange, apple
3 pear, grape

Any suggestions would be appreciated.


See More: Excel VBA: find dupes, remove, add string

Report •


#1
February 5, 2011 at 16:31:51
re: "Sounds easy, but it's not"

I guess that depends on your definition of "easy".

This code will place the following strings in Column C and then delete Columns A & B:

1 apple, pear, grape
2 orange, apple
3 pear, grape

Note: I have commented out the line that deletes Columns A & B so that it won't actually delete them when you test the code.

I strongly suggest that you test this in a backup copy of your workbook since macros can not be undone.


Option Explicit
Sub StringMaker()
Dim lastRow, srcRow, dstRow As Integer
Dim tmpString, finalString As String
'Determine length of data
  lastRow = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Initialize source row variable
  srcRow = 1
nxtTry:
'Are we done?
  If srcRow > lastRow Then
   'Columns("A:B").Delete
   Exit Sub
  End If
'If tmpString is empty, start building new string
   If tmpString = "" Then tmpString = _
     Cells(srcRow, 1) & " " & Cells(srcRow, 2) & ", "
'Keep appending to tmpString if Column A has matching values
    If Cells(srcRow + 1, 1) = Cells(srcRow, 1) Then
        tmpString = tmpString & Cells(srcRow + 1, 2) & ", "
        srcRow = srcRow + 1
    Else:
'No more matches
'Strip off trailing comma and space
         finalString = Left(tmpString, Len(tmpString) - 2)
'Increment destination row and place final string in Column C
         dstRow = dstRow + 1
         Cells(dstRow, 3) = finalString
'Increment source row and clear tmpString
         srcRow = srcRow + 1
         tmpString = ""
       End If
'Let's do it all again
  GoTo nxtTry
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
February 7, 2011 at 07:07:13
Derby Dad,

This looks very close to what I am working on, although it looks using the tmpstring method is much better than my "live" replace. I am going to try it today. Thanks so much for your quick reply!


Report •

#3
February 7, 2011 at 10:19:49
Ah! So close! Col A, containing the numbers, stay as a seperate column, whlie the adding of strings in Col B do end up in Col C , the way you've written.

I think I can tweak that part.

Thanks!


Report •

Related Solutions

#4
February 8, 2011 at 13:42:25
All,

SOLVED

This is what ended up working for those who are keeping track.

Sub StringMaker2()

' 2/8/11 RA, TC

Dim lastRow, srcRow, dstRow As Integer
Dim tmpStringID, tmpStringFeed, finalString As String
Dim X, Y As Long


'Determine length of data
lastRow = Range("A" & Rows.Count).End(xlUp).Row
' find unique Asset ID
' X is first counter for the asset ID
For X = 2 To lastRow - 1
tmpStringID = Cells(X, 1)
tmpStringFeed = Cells(X, 8)
' Y is the second counter

For Y = X + 1 To lastRow
If tmpStringID = Cells(Y, 1).Text Then
tmpStringFeed = tmpStringFeed & ", " & Cells(Y, 8).Text
Cells(Y, 1) = Empty
Else
Cells(X, 8) = tmpStringFeed
X = Y - 1
Exit For
End If

Next Y

Next X

' If the asset ID cell is empty, then delete that row
Paco:
lastRow = Range("A" & Rows.Count).End(xlUp).Row

For X = 2 To lastRow
If Cells(X, 1).Text = "" Then
Rows(X).Delete
Exit For
End If
Next X
If X <= lastRow Then
GoTo Paco
End If

End Sub


Thanks!!



Report •

#5
February 8, 2011 at 14:15:17
re: "This is what ended up working for those who are keeping track"

Works for what?

As far as I can tell, there is no way that code does what you asked for in your original post.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •


Ask Question