Merge rows if it meets criteria in Excel
Solved/Closed
cacaip89
rizvisa1
- Posts
- 5
- Registration date
- Monday February 28, 2011
- Status
- Member
- Last seen
- March 2, 2011
rizvisa1
- Posts
- 4479
- Registration date
- Thursday January 28, 2010
- Status
- Contributor
- Last seen
- May 5, 2022
Related:
- Excel macro to merge cells based on condition
- Excel merge cells if condition met - Best answers
- Excel merge cells based on condition - Best answers
- Short cut to merge cells ✓ - Forum - Excel
- Excel Macro copy to cell based on criteria ✓ - Forum - Excel
- Excel macro to delete columns based on header ✓ - Forum - Excel
- Excel - macro to lookup cell and add new row - How-To - Excel
- Copy cells based on conditions ✓ - Forum - Excel
5 replies
rizvisa1
Mar 4, 2011 at 06:05 PM
- Posts
- 4479
- Registration date
- Thursday January 28, 2010
- Status
- Contributor
- Last seen
- May 5, 2022
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