ExcelBanter - select distinct row

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - select distinct row (https://www.excelbanter.com/excel-programming/295903-select-distinct-row.html)

select distinct row

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/

.

select distinct row

Here is some code

Dim iLastRow As Long
Application.ScreenUpdating = False
With Worksheets("Sheet1")
iLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A1").EntireRow.Insert
.Columns("A:A").AutoFilter Field:=1, Criteria1:="Andy"
.Range("A2:A" & iLastRow +
1).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Destination:=Worksheets("Sheet2").Range("A1")
.Range("A1").EntireRow.Delete
End With
Application.ScreenUpdating = True

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"weejeow " wrote in 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/

select distinct row

Here is a solution using SQL.
1. Save your original workbook.
2. Create a new Workbook and paste this code in the ThisWorkbook module.

Sub Split()
Set ADORS = CreateObject("ADODB.RecordSet")
Cnn = "Provider=MSDASQL;Driver={Microsoft Excel Driver (*.xls)};DBQ=c:\distinct.xls;"
Sql = "Select * from [Sheet1$]"
ADORS.Open Sql, Cnn ' All the data
AddColNames ADORS, 1
ADORS.Close
Sql = "select * from [Sheet1$] where name in (SELECT distinct(name)FROM [Sheet1$] group by name having count(name)= 1;)"
ADORS.Open Sql, Cnn ' Unique by Name
AddColNames ADORS, 2
ADORS.Close
Sql = "select * from [Sheet1$] where name in (SELECT distinct(name)FROM [Sheet1$] group by name having count(name) 1;)"
ADORS.Open Sql, Cnn ' Recurring by Name
AddColNames ADORS, 3
ADORS.Close
Set ADORS=Nothing
End Sub

Sub AddColNames(ByVal RS As Variant, ByVal SheetNo As Integer)
Col = 1
For Each fld In RS.Fields
ActiveWorkbook.Sheets(SheetNo).Cells(1, Col) = fld.Name
Col = Col + 1
Next
ActiveWorkbook.Sheets(SheetNo).Range("A2").CopyFro mRecordset RS
End Sub

3. Run the sub Split.

CA
a. Replace C:\distinct.xls with the location and name of your workbook in the Cnn string.
b. I have assumed that the original data is in Sheet1, that the unique data goes in Sheet2, and the recurring data goes in Sheet3: your new workbook must have at least 3 sheets.

You might be able to adapt the code to work within your original workbook: I don't know how this is structured.

select distinct row

Thanks Patrick, Bob and ~X,

it is a struggle for me to understand VB again as i am more of a we
programmer. But anyway i am trying to understand the logic.
Patrick's code works fine with me and i am tryin to customise it
Thanks for your guidance.

Cheers,
Darre

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

select distinct row

Check out:
http://www.contextures.com/excelfiles.html
Scroll down to Filters: and then to
Create New Sheets from Filtered List
Download file: AdvFilterRepFiltered.xls
and see if this would help you.
HTH
JMay

"weejeow " wrote in 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/

select distinct row

"AA2e72E" wrote in message ...
Here is a solution using SQL <snip

I think the OP wants a new worksheet for each distinct 'name'. This
would involve a curosr to loop through the distinct names and create
each sheet, so for a change I'd say a SQL solution wouldn't be the
best.

--

select distinct row

Read the SQL again
The first one reads all the rows- puts the result is Sheet
The second one reads the distinct rows - put the results in Sheet
The third one reads the recurring rows - puts the result in Sheet

The original question specified that if a name is recuring, all its records go into the 'recuring' sheet.

select distinct row

Hie guys,

i did found the macro i needed fro
http://www.contextures.com/excelfiles.html

I downloaded CopyToWkBk.exl and it works as what i wanted. The onl
problem is that how do i sum up the total and also include a footer fo
eact sheet? for each each row varies from each sheets?

Thanks in advance!

Cheer

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