Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
select distinct row
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 t automatically create the sheet and transfer the row distinctly b "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! Cheer -- Message posted from http://www.ExcelForum.com |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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/ . |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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/ |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
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/ |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. -- |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Help With MS Query Sum Distinct | Excel Discussion (Misc queries) | |||
distinct | Excel Worksheet Functions | |||
Distinct | Excel Worksheet Functions | |||
Select Distinct Maximums | Excel Worksheet Functions | |||
howto select distinct values from list | Excel Worksheet Functions |