Merge rows if it meets criteria in Excel

Solved/Closed
cacaip89 Posts 5 Registration date Monday February 28, 2011 Status Member Last seen March 2, 2011 - Mar 1, 2011 at 07:07 PM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Jun 21, 2011 at 06:14 PM
Hello,

I would like to know if I can merge rows if it meets certain criteria in Excel. If Project ID on column A is matched, it will merge all the data on launch qty into column U of the other worksheet.

For example:

Worksheet 1:

Column A Column J

P-123 IB100: 367500
P-124 IB300: 1000
P-123 IB123: 10003
P-123 IB145: 1002
P-124 IB121: 3000

WorkSheet 2:

Column Q Column U

P-123 IB100: 367500,IB123: 10003,IB145: 1002
P-124 IB300: 1000,IB121: 3000

Thanks for the help!

5 responses

rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Mar 4, 2011 at 06:05 PM
here

Sub doCopyData()
   Dim lRow             As Long
   Dim sUnqID           As String
   Dim Cell             As Range
   Dim lTgtRow          As Long
   
   lRow = 1
   Do While (Sheets("Sheet1").Cells(lRow, "A") <> vbNullString)
      sUnqID = Sheets("Sheet1").Cells(lRow, "A")
       Debug.Print sUnqID
      Set Cell = Sheets("Sheet2").Range("Q:Q").Find(sUnqID, Sheets("Sheet2").Cells(Rows.Count, "Q"), , xlWhole, xlByRows, xlNext)
      If (Cell Is Nothing) _
      Then
         Set Cell = Sheets("Sheet2").Cells.Find("*", Sheets("Sheet2").Cells(1, 1), , xlWhole, xlByRows, xlPrevious)
         If Cell Is Nothing _
         Then
            lTgtRow = 1
         Else
            lTgtRow = Cell.Row + 1
         End If
         Sheets("Sheet2").Cells(lTgtRow, "Q") = sUnqID
         Sheets("Sheet2").Cells(lTgtRow, "U") = Sheets("Sheet1").Cells(lRow, "J")
      Else
         lTgtRow = Cell.Row
         If (Sheets("Sheet2").Cells(lTgtRow, "U") = vbNullString) _
         Then
            Sheets("Sheet2").Cells(lTgtRow, "U") = Sheets("Sheet1").Cells(lRow, "J")
         Else
            Sheets("Sheet2").Cells(lTgtRow, "U") = Sheets("Sheet2").Cells(lTgtRow, "U") & ", " & Sheets("Sheet1").Cells(lRow, "J")
         End If
      End If
      lRow = lRow + 1
   Loop
End Sub
1