View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
patrick molloy patrick molloy is offline
external usenet poster
 
Posts: 391
Default select distinct row

Add the following code to a standard code module.
[use Alt+F11 to open the IDE then Insert/Module]

Option Explicit

Sub ProcessData()
Dim ThisRow As Long
Dim lastrow As Long
Dim ws As Worksheet
Dim rTarget As Range
Dim rSource As Range
Dim ThisSheet As Worksheet

'initialise
Set ThisSheet = ActiveSheet ' sheet1 is active
ThisRow = 2

Do Until ThisSheet.Cells(ThisRow, 1) = ""

With ThisSheet
Set rSource = _
.Range(.Cells(ThisRow, "A"), _
.Cells(ThisRow, "C"))
End With

Set ws = _
GetSheet(ThisSheet.Cells(ThisRow, 1).Value)

If ws Is Nothing Then
MsgBox "Failed to create " _
& Cells(ThisRow, 1).Value
Exit Sub
End If

lastrow = _
ws.Range("A65000").End(xlUp).Row

If lastrow = 1 Then
ws.Range("A1:C1").Value = _
ThisSheet.Range("A1:C1").Value
End If
lastrow = lastrow + 1

With ws
Set rTarget = _
.Range(.Cells(lastrow, "A"), _
.Cells(lastrow, "C"))
End With


rTarget.Value = rSource.Value

ThisRow = ThisRow + 1
Loop



End Sub
Private Function GetSheet(sName As String) As Worksheet
On Error Resume Next
Set GetSheet = Worksheets(sName)
If Err.Number < 0 Then
Err.Clear
Set GetSheet = _
Worksheets.Add(after:=Worksheets(Worksheets.Count) )
GetSheet.Name = sName
End If
End Function


This code moves doen column A of sheet 1, setting a
variable to the worksheet with the name in that
column.... the function returns a worksheet object - the
function assigns the worksheet if it exists or adds the
sheet if it doesn't
then the code says that if the last row was row 1, it 's
a new sheet so add the headers, otherwist set the next row

HTH
Patrick Molloy
Microsoft Excel MVP


-----Original Message-----
Hie guys,

i need another guide.

how can i select distinct row and transfer to another

sheets?
below are the example in sheet 1:

Name | Payment | Date
-----------------------------
John | $50 | 20/04/04
Andy | $28 | 20/04/04
Andy | $10 | 21/04/04


so for sheet 2 and 3, how do i come about macro/function

to
automatically create the sheet and transfer the row

distinctly by
"Name"?

eg:
Sheet 2

Name | Payment | Date
-----------------------------
John | $50 | 20/04/04


eg:
Sheet 3

Name | Payment | Date
-----------------------------
Andy | $28 | 20/04/04
Andy | $10 | 21/04/04

Thanks in advance!

Cheers


---
Message posted from http://www.ExcelForum.com/

.