Sort Range and Sum/Delete Duplicate Rows
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 data range is C10 to P18000 +. The end row will vary. Cell E5 contains a key word which should be utilized to paste the Range C10: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) Sort the active data range C10: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 |
Sort Range and Sum/Delete Duplicate Rows
Because you have so many lines, it is better to mark the delete lines with
an X. then sort the 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 While Range("D" & RowCount) < "" If Range("D" & RowCount) = _ Range("D" & (RowCount + 1)) Then 'Put an x in rows to delete Range("IV" & RowCount) = "X" 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 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 data range is C10 to P18000 +. The end row will vary. Cell E5 contains a key word which should be utilized to paste the Range C10: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) Sort the active data range C10: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 |
Sort Range and Sum/Delete Duplicate Rows
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. *then sort the 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 While Range("D" & RowCount) < "" * * * If Range("D" & RowCount) = _ * * * * *Range("D" & (RowCount + 1)) Then * * * * *'Put an x in rows to delete * * * * *Range("IV" & RowCount) = "X" * * * 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 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 data range is C10 to P18000 +. The end row will vary. Cell E5 contains a key word which should be utilized to paste the Range C10: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) Sort the active data range C10: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 |
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" 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 18, 6:55 pm, Joel wrote: Because you have so many lines, it is better to mark the delete lines with an X. then sort the 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 While Range("D" & RowCount) < "" If Range("D" & RowCount) = _ Range("D" & (RowCount + 1)) Then 'Put an x in rows to delete Range("IV" & RowCount) = "X" 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 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 data range is C10 to P18000 +. The end row will vary. Cell E5 contains a key word which should be utilized to paste the Range C10: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) Sort the active data range C10: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 |
Sort Range and Sum/Delete Duplicate Rows
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 |
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 |
Sort Range and Sum/Delete Duplicate Rows
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 - |
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) 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 - |
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 |
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 |
All times are GMT +1. The time now is 04:13 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com