On 12 Mai, Born to Win 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
>
> Thanks,
> prabhat
The following does the same as the code in the first answer, only much
faster.
Sub PrintServiceColumnWise2()
' Select the contents of the sheet "Base" into an array for
' further processing (moving through an array is less expensive
' than working with the cells of the worksheet directly).
Dim SourceSheet As Excel.Worksheet
Set SourceSheet = Worksheets("Base")
Dim SourceCell As Excel.Range
Set SourceCell = SourceSheet.Range( _
SourceSheet.Cells(2, 1), _
SourceSheet.Cells.SpecialCells(xlCellTypeLastCell))
Dim SourceArray As Variant
SourceArray = SourceCell.Value
ReDim TargetArray(UBound(SourceArray, 1), 10) As Variant
' Go through the first column in the source sheet until we find
' an empty cell.
Dim TargetRow As Long
TargetRow = -1
Dim TargetColumn As Long
TargetColumn = 0
Dim SourceRow As Long
For SourceRow = LBound(SourceArray) To UBound(SourceArray, 1)
' 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 <> SourceArray(SourceRow, 1) 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.
TargetRow = TargetRow + 1
TargetArray(TargetRow, 0) = SourceArray(SourceRow, 1)
TargetArray(TargetRow, 1) = SourceArray(SourceRow, 4)
TargetColumn = 1
LastMISDN = SourceArray(SourceRow, 1)
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.
TargetColumn = TargetColumn + 1
TargetArray(TargetRow, TargetColumn) = SourceArray(SourceRow, 4)
End If
' Remember the MISDN that we have seen in this iteration and
' advance the source cell to the next row.
SourceRow = SourceRow + 1
Next
Worksheets("Desire format").Range(Cells(4, 1), _
Cells(4 + UBound(TargetArray),
11)).Value = TargetArray
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
