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
|