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
        rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Jun 21, 2011 at 06:14 PM
        Related:         
- Merge cells based on condition excel
- Based on the cell values in cells b77 ✓ - Excel Forum
- Based on the values in cells b77 b88 ✓ - Excel Forum
- Name Values - Excel Forum
- Based on the values in cells b77 ✓ - Excel Forum
- Merge twitter accounts - Guide
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
    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
                
                