View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default Sort Range and Sum/Delete Duplicate Rows


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