Hi,
You can try the following code:
I wrote two macros: Mergecontents and move contents.
Mergecontents will merge teh contents into the d column of your last row of
the email pattern
movecontents can be used to move the result to the first row of your email
pattern
Execute the mergecontents first and then the movecontants.
Let me know if this helps!!
Regards,
Praveen
*Sub mergecontents()
' Coded by Praveen
' This code sets up the CC into D column into the last row of the email id
pattern
last_row = Range("B65536").End(xlUp).Row 'To Retrieve the last Row in col B
First_val = Range("b2").Value 'Setting up Initial Value
curr_first_row = 2 'curr_first_row indicates the first row of new email
id pattern found
For i = 2 To last_row + 1
curr_val = Range("B" & i).Value
If (curr_val = First_val) Then
If (i <> 2) Then
'For all rows except first row concatenating the contents with ";"
Range("D" & i).Value = Range("D" & i - 1).Value & ";" & Range("A" &
i).Value
Else
' This is executed only for the first row
Range("D" & i).Value = Range("A" & i).Value
End If
Else
' Removing Unnecessary contents in othe rows
For j = curr_first_row To i - 2
Range("D" & j).Value = ""
Next
' setting up values for the next email id pattern
curr_first_row = i
First_val = curr_val
Range("D" & i).Value = Range("A" & i).Value
End If
Next
End Sub
Sub movecontents()
' This code can be used to move the contents to the first row of your email
pattern
last_row = Range("D65536").End(xlUp).Row 'To Retrieve the last Row in col D
fill_row = 2
For i = 2 To last_row
If Range("D" & i) <> "" Then
Range("D" & fill_row) = Range("D" & i)
Range("D" & i) = ""
fill_row = i + 1
End If
Next
End Sub*
On Sun, Dec 27, 2009 at 11:50 AM, mahesh parab <[email protected]> wrote:
> Dear All
>
>
> I need help in attach sheet,if value in column B is same then, it merge
> cell of A column, in one cell,
> till column B contain same value. i go through net but didnt get any such
> formula or
> vb code.
>
> I will appreciate any help on this.
>
>
>
>
> i am trying to modify below mention code as per my requirement but it didnt
> works.
>
> Sub BT()
> Const iCol As Long = 1 ' pick your column
>
> Dim iRow As Long
> Dim jRow As Long
> Dim cell As Excel.Range
> Dim rMrg As Excel.Range
>
> iRow = 2 ' pick your start row
> Application.DisplayAlerts = False
>
> Do while not IsEmpty(Cells(iRow, iCol))
> Set rMrg = Cells(iRow, iCol)
> jRow = 1
>
> Do While Cells(iRow + jRow, iCol).Value = Cells(iRow, iCol).Value
> Set rMrg = Union(rMrg, Cells(iRow + jRow, iCol))
> jRow = jRow + 1
> Loop
>
> rMrg.Merge
> iRow = iRow + jRow
> Loop
> Application.DisplayAlerts = True
> End Sub
>
> --
>
> ----------------------------------------------------------------------------------
> Some important links for excel users:
> 1. Follow us in TWITTER for tips tricks and links :
> http://twitter.com/exceldailytip
> 2. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at
> http://www.excelitems.com
> 3. Excel tutorials at http://www.excel-macros.blogspot.com
> 4. Learn VBA Macros at http://www.quickvba.blogspot.com
> 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
>
>
> To post to this group, send email to [email protected]
> If you find any spam message in the group, please send an email to:
> Ayush Jain @ [email protected]
> <><><><><><><><><><><><><><><><><><><><><><>
> HELP US GROW !!
>
> We reach over 6,500 subscribers worldwide and receive many nice notes about
> the learning and support from the group.Let friends and co-workers know they
> can subscribe to group at
> http://groups.google.com/group/excel-macros/subscribe
>
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us in TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at
http://www.excelitems.com
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to [email protected]
If you find any spam message in the group, please send an email to:
Ayush Jain @ [email protected]
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 6,500 subscribers worldwide and receive many nice notes about the
learning and support from the group.Let friends and co-workers know they can
subscribe to group at http://groups.google.com/group/excel-macros/subscribe
