Solved: add data in one cell based on condition

[anandbohra]

Hi all

i have data in following format

data-value( alpha numeric) each is in individual row
1 - syrup50%
1 - tablet50%
2 - coal10%
2 - cast30%
2 - mine60%

& so on
now i want the data to be shown as
row 1
1 - syrup50%
tablet50%
row 2
2 - coal10%
cast30%
mine60%

means corresponding data should merge in one cell only

pl help me to achieve my purpose
VBA or excel formula any one of them will do.

[Bob Phillips]

[vba]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim iLastRow As Long

With ActiveSheet

Application.ScreenUpdating = False

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = iLastRow To 2 Step -2
.Cells(i - 1, "B").Value = .Cells(i, TEST_COLUMN).Value
.Rows(i).Delete
Next i

Application.ScreenUpdating = True

End With

End Sub[/vba]

[anandbohra]

i think i am unable to explain my question.
kindly look into attached file

[Bob Phillips]

I think you did explain it, I just made a lousy job of reading it.

[vba]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim iLastRow As Long

With ActiveSheet

Application.ScreenUpdating = False

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To iLastRow
.Cells(i, TEST_COLUMN).Value = .Cells(i, TEST_COLUMN).Value & " " & _
.Cells(i, "B").Value
.Cells(i, "B").ClearContents
Next i

.Columns(1).AutoFit

Application.ScreenUpdating = True

End With

End Sub
[/vba]

[anandbohra]

Still this is not the solution which i need.
your given code simply merge data of column A & B & clear contents of column B.

what i want first it generates unique value for column A in new sheet (i have code for it)

[VBA]Sub uniqueLoop()
On Error Resume Next
' Keyboard Shortcut: Ctrl+Shift+U

Dim c As Long
'start at Col M (13)
c = 1
'look to right until blank column found
Do
'check row 1, Col # is blank
If Cells(1, c) <> "" Then
' not blank, check next col #
c = c + 1
Else
'Col is blank. Exit Do/Loop
Exit Do
End If
Loop
Selection.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(1, c), unique:=True

MsgBox "Check the Unique data starting from " & Cells(1, c).Address, vbInformation, "Anand M. Bohra"
ActiveWorkbook.Names("Extract").Delete
ActiveSheet.Names("Extract").Delete

End Sub

[/VBA]

then based on that unique values put all the corresponding column B values in one cell next to it

(for running code smoothly i am ready to sort the data & do whatever preliminary formatting is necessary)

hope now my query is clear.

[Bob Phillips]

[vba]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim iLastRow As Long

With ActiveSheet

Application.ScreenUpdating = False

.Range("A1").CurrentRegion.Sort key1:=.Range("A1"), order1:=xlAscending, header:=xlYes
iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = iLastRow To 2 Step -1
If .Cells(i, TEST_COLUMN).Value = .Cells(i - 1, TEST_COLUMN).Value Then
.Cells(i - 1, "B").Value = .Cells(i - 1, "B").Value & vbNewLine & _
.Cells(i, "B").Value
.Rows(i).Delete
End If
Next i

Application.ScreenUpdating = True

End With

End Sub
[/vba]

[anandbohra]

Thank u very much xld