On 12 Mai, 13:22, Born to Win <[email protected]> wrote:
> Hi Experts,
>
> in attached excel file you can see contact no. along with many services
> activated on a single no. & you can find it in separate entry i am trying to
> write a VB program so that i would have unique no. & services (column wise)
> in new sheet in one column after a single click. please help me out
Copy the following code into the worksheet Desire format, add a button
that executes the sub PrintServiceColumnWise
______________________________________________________
' This forces us to declare all variables with a DIM statement (so
' we cannot get any errors due to mis-typed variable names).
Option Explicit
Sub PrintServiceColumnWise()
Dim SourceCell As Excel.Range
Set SourceCell = Worksheets("Base").Cells(2, 1)
Dim TargetCell As Excel.Range
Set TargetCell = Worksheets("Desire format").Cells(3, 1)
' Go through the first column in the source sheet until we find
' an empty cell.
While SourceCell.Value <> ""
' How we have to proceed depends on whether we have seen the
' current MISDN in the last source row.
Dim LastMISDN As String
If LastMISDN <> SourceCell.Value Then
' If we see the MISDN for the first time, we copy the
' MISDN into the first column and copy the service into
' first service column.
Set TargetCell = TargetCell.Offset(1, -TargetCell.Column + 1)
TargetCell.Value = SourceCell.Value
Set TargetCell = TargetCell.Offset(0, 1)
TargetCell.Value = SourceCell.Offset(0, 3).Value
Else
' If we have seen the MISDN in the last iteration, we have to
' put the current service in the next column
' instead of the next row.
Set TargetCell = TargetCell.Offset(0, 1)
TargetCell.Value = SourceCell.Offset(0, 3)
End If
' Remember the MISDN that we have seen in this iteration and
' advance the source cell to the next row.
LastMISDN = SourceCell.Value
Set SourceCell = SourceCell.Offset(1, 0)
Wend
End Sub
________________________________________________________
Regards,
Stuart
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
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]
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
