Merge rows if it meets criteria in Excel
Solved/Closed
cacaip89
Posts
5
Registration date
Monday 28 February 2011
Status
Member
Last seen
2 March 2011
-
1 Mar 2011 à 19:07
rizvisa1 Posts 4478 Registration date Thursday 28 January 2010 Status Contributor Last seen 5 May 2022 - 21 Jun 2011 à 18:14
rizvisa1 Posts 4478 Registration date Thursday 28 January 2010 Status Contributor Last seen 5 May 2022 - 21 Jun 2011 à 18:14
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
- Merge whatsapp backups ✓ - WhatsApp Forum
- Return Seq Values Until Blank value then return different set of seq values ✓ - Excel Forum
- Merge twitter accounts - Guide
5 responses
rizvisa1
Posts
4478
Registration date
Thursday 28 January 2010
Status
Contributor
Last seen
5 May 2022
766
4 Mar 2011 à 18:05
4 Mar 2011 à 18:05
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