Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Sort Range and Sum/Delete Duplicate Rows
 
 
LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 39
Default Sort Range and Sum/Delete Duplicate Rows
On Jul 20, 8:58*pm, Joel wrote:
Sub ExportData()
'
' Macro1 Macro
' Macro recorded 7/18/2008 by Joel
'

'
* *LastRow = Range("D" & Rows.Count).End(xlUp).Row
* *Range("C10:C" & LastRow).Value = Range("E5").Value
* *Set SortRange = Range("C10:P" & LastRow)

* *SortRange.Sort _
* * * *Key1:=Range("F10"), _
* * * *Order1:=xlAscending, _
* * * *Key2:=Range("H10"), _
* * * *Order2:=xlDescending, _
* * * *Header:=xlGuess

* *RowCount = 10
* *Do While Range("F" & RowCount) < ""
* * * If Range("F" & RowCount) = _
* * * * *Range("F" & (RowCount + 1)) Then

* * * * *'Put an x in rows to delete
* * * * *Range("IV" & RowCount) = "X"
* * * * *'total rows
* * * * *Range("K" & (RowCount + 1)) = _
* * * * * * Range("K" & (RowCount + 1)) + _
* * * * * * Range("K" & RowCount)

* * * * *If Range("H" & (RowCount + 1)) < _
* * * * * * Range("H" & RowCount) Then

* * * * * * Range("H" & (RowCount + 1)) = _
* * * * * * * *Range("H" & RowCount)
* * * * *End If
* * * End If
* * * RowCount = RowCount + 1
* *Loop

* *'sort the deleted Rows to top of the spreadsheet and then delete these rows
* *Set SortRange = Range("C10:IV" & LastRow)
* *SortRange.Sort _
* * * *Key1:=Range("IV10"), _
* * * *Order1:=xlDescending, _
* * * *Header:=xlGuess
* *LastRow = Range("IV" & Rows.Count).End(xlUp).Row
* *Rows("10:" & LastRow).Delete
* *Columns("IV").Delete

* *'Get Number of rows after duplicates are deleted
* *LastRow = Range("D" & Rows.Count).End(xlUp).Row
* *NewRow = LastRow + 2
* *Range("J" & NewRow) = "TOTAL"
* *Range("K" & NewRow).Formula = "=SUM(K10:K" & LastRow & ")"

End Sub



" wrote:
Hi Joel,
The Macro works perfectly but Col H (which are dates) does not give
the desired results.
I want to keep the latest date visible after all the duplicate rows
are deleted. For eg

Col F * * *Col H
AAA * * * 20/1/2007
AAA * * * 20/2/2007
AAA * * * 20/3/2007
...
...
...
the result visible after sort Descending and deletion of duplicate
rows should be

AAA * * *20/3/2007

Can you suggest something please.

Thanks for all your help and time

Rashid Khan

On Jul 19, 4:49 pm, Joel wrote:
Sub ExportData()
'
' Macro1 Macro
' Macro recorded 7/18/2008 by Joel
'

'
* *LastRow = Range("D" & Rows.Count).End(xlUp).Row
* *Range("C10:C" & LastRow).Value = Range("E5").Value
* *Set SortRange = Range("C10:P" & LastRow)

* *SortRange.Sort _
* * * *Key1:=Range("F10"), _
* * * *Order1:=xlAscending, _
* * * *Key2:=Range("H10"), _
* * * *Order2:=xlDescending, _
* * * *Header:=xlGuess

* *RowCount = 10
* *Do While Range("F" & RowCount) < ""
* * * If Range("F" & RowCount) = _
* * * * *Range("F" & (RowCount + 1)) Then

* * * * *'Put an x in rows to delete
* * * * *Range("IV" & RowCount) = "X"
* * * * *'total rows
* * * * *Range("K" & (RowCount + 1)) = _
* * * * * * Range("K" & (RowCount + 1)) + _
* * * * * * Range("K" & RowCount)

* * * End If
* * * RowCount = RowCount + 1
* *Loop

* *'sort the deleted Rows to top of the spreadsheet and then delete these rows
* *Set SortRange = Range("C10:IV" & LastRow)
* *SortRange.Sort _
* * * *Key1:=Range("IV10"), _
* * * *Order1:=xlDescending, _
* * * *Header:=xlGuess
* *LastRow = Range("IV" & Rows.Count).End(xlUp).Row
* *Rows("10:" & LastRow).Delete
* *Columns("IV").Delete

* *'Get Number of rows after duplicates are deleted
* *LastRow = Range("D" & Rows.Count).End(xlUp).Row
* *NewRow = LastRow + 2
* *Range("J" & NewRow) = "TOTAL"
* *Range("K" & NewRow).Formula = "=SUM(K10:K" & LastRow & ")"

End Sub

" wrote:
On Jul 19, 12:48 am, Joel wrote:
Sub ExportData()
'
' Macro1 Macro
' Macro recorded 7/18/2008 by Joel
'

'
* *LastRow =Range("D" & Rows.Count).End(xlUp).Row
* *Range("C10:C" & LastRow).Value =Range("E5").Value
* *Set SortRange =Range("C10:P" & LastRow)

* *SortRange.Sort_
* * * *Key1:=Range("F10"), _
* * * *Order1:=xlAscending, _
* * * *Key2:=Range("H10"), _
* * * *Order2:=xlDescending, _
* * * *Header:=xlGuess

* *RowCount = 10
* *Do WhileRange("F" & RowCount) < ""
* * * IfRange("F" & RowCount) = _
* * * * *Range("F" & (RowCount + 1)) Then

* * * * *'Put an x in rows to delete
* * * * *Range("IV" & RowCount) = "X"
* * * End If
* * * RowCount = RowCount + 1
* *Loop

* *'sortthe deleted Rows to top of the spreadsheet and then delete these rows
* *Set SortRange =Range("C10:IV" & LastRow)
* *SortRange.Sort_
* * * *Key1:=Range("IV10"), _
* * * *Order1:=xlDescending, _
* * * *Header:=xlGuess
* *LastRow =Range("IV" & Rows.Count).End(xlUp).Row
* *Rows("10:" & LastRow).Delete
* *Columns("IV").Delete

* *'Get Number of rows after duplicates are deleted
* *LastRow =Range("D" & Rows.Count).End(xlUp).Row
* *NewRow = LastRow + 2
* *Range("J" & NewRow) = "TOTAL"
* *Range("K" & NewRow).Formula = "=SUM(K10:K" & LastRow & ")"

End Sub

" wrote:
On Jul 18, 6:55 pm, Joel wrote:
Because you have so many lines, *it is better to mark the delete lines with
an X. *thensortthe X's to the top of the file and delete all the rows as a
single group. *this code should run in seconds instead of minutes. *I used
column IV to put the X for deletion then deleted column IV.

Sub ExportData()
'
' Macro1 Macro
' Macro recorded 7/18/2008 by Joel
'

'
* *LastRow =Range("D" & Rows.Count).End(xlUp).Row
* *Range("C10:C" & LastRow).Value =Range("E5").Value
* *Set SortRange =Range("C10:P" & LastRow)

* *SortRange.Sort_
* * * *Key1:=Range("F10"), _
* * * *Order1:=xlAscending, _
* * * *Key2:=Range("H10"), _
* * * *Order2:=xlDescending, _
* * * *Header:=xlGuess

* *RowCount = 10
* *Do WhileRange("D" & RowCount) < ""
* * * IfRange("D" & RowCount) = _
* * * * *Range("D" & (RowCount + 1)) Then

* * * * *'Put an x in rows to delete
* * * * *Range("IV" & RowCount) = "X"
* * * End If
* * * RowCount = RowCount + 1
* *Loop

* *'sortthe deleted Rows to top of the spreadsheet and then delete these rows
* *Set SortRange =Range("C10:IV" & LastRow)
* *SortRange.Sort_
* * * *Key1:=Range("IV10"), _
* * * *Order1:=xlDescending, _
* * * *Header:=xlGuess
* *LastRow =Range("IV" & Rows.Count).End(xlUp).Row
* *Rows("10:" & LastRow).Delete
* *Columns("IV").delete
End Sub

" wrote:
Hello All,
I am using Excel 2003 and have the following problem.

We export some data in excel on a regular basis (about 18000+ rows)..
Row 9 is the header row
The datarangeis C10 to P18000 +. The end row will vary.

Cell E5 contains a key word which should be utilized to paste the
RangeC10:C18000+ (all active Rows) with the Key word. *For eg, if E5
contains the text A then C10:C18000+ should display Account, if E5 = B
then C10:C18000+ should display Balance.

I wish to have a macro which should do the following:

a) *Paste the key word as described above.

b)Sortthe active datarangeC10:P18000+ using Col F (Primary Key -
Ascending) and Col H (Secondary Key – Descending).

b) After Sorting, Sum Col K (for all duplicate rows only) and Remove
Duplicate Rows using Col D to verify duplicate Rows.

Hope someone can help me

Thanks in advance

Rashid Khan- Hide quoted text -

- Show quoted text -

Hi Joel,
Thanks for your prompt reply.
I want to Sum Col K which is not done in the macro given by you..
Also Col F should be used to verify the duplicate Rows (by mistake I
mentioned Col D in my previous post)

Thanks for your help once again

Rashid Khan- Hide quoted text -

- Show quoted text -

Hi Joel,
I am sorry I think I did not explain my problem properly. *Please see
below an example showing Before and After results

Before (duplicate rows in Col F with different amounts in Col K)
Col F * * * * * * * * * *Col K
Joe Smith * * * * * $200.00
Joe Smith * * * * * $300.00
Joe Smith * * * * * $250.00
Kip Tucker * * * * *$100.00
Kip Tucker * * * * *$150.00
Kip Tucker * * * * *$200.00

After (duplicate rows in Col F are deleted showing Sum of amounts in
Col K)
Joe Smith * * * * * $750.00
Kip Tucker * * * * *$450.00

Thanks for you help and time once again.

Rashid Khan- Hide quoted text -

- Show quoted text -- Hide quoted text -

- Show quoted text -

Thanks a million. Works perfect
Rashid Khan
Reply With QuoteReply With Quote
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Threaded Mode Threaded Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
delete duplicate rows, keep one Wasdell Excel Discussion (Misc queries) 1 October 30th 09 12:16 PM
Delete Duplicate rows Alan Beban Excel Programming 0 December 23rd 06 06:42 PM
Delete Duplicate rows KC Rippstein Excel Programming 0 December 22nd 06 08:15 PM
Delete Duplicate rows in a range UK[_2_] Excel Programming 1 April 14th 04 01:28 PM
Delete duplicate rows christina Excel Programming 1 August 4th 03 01:04 PM


All times are GMT +1. The time now is 06:35 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement