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

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

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

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

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

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

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 -

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 -

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

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