Deleting rows following the max point

[Lucile]

Hi all,
I have set of data that increase to reach a maximum and decrease after that.
I need to find the maximum and delete all the data after this maximum.
I can not find how to delete the entire row after my max point....

The begining of my code:

Sub remove_decrease()
'Remove decrease portion portion
Dim top
top = Application.Match(Application.max(Columns(1)), Columns(1), 0)
'Give the position of the maximum force = top
top = top + 1
'.... need to remove all the next rows...
End Sub


Thanks!

 

[Mike H]

Hi,

Try this

Sub remove_decrease()
Dim RowNo As Long, lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
TheMax = WorksheetFunction.Max(Columns(1))
TheRow = Columns(1).Find(What:=TheMax, After:=Cells(1, 1)).Row
Range("A" & TheRow + 1 & ":A" & lastrow).ClearContents
End Sub

Mike

 

[Mike H]

Ah,

You wanted to delete the entire row not just clear then contents. Try this
instead

Sub remove_decrease()
Dim RowNo As Long, lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
TheMax = WorksheetFunction.Max(Columns(1))
TheRow = Columns(1).Find(What:=TheMax, After:=Cells(1, 1)).Row
Range("A" & TheRow + 1 & ":A" & lastrow).EntireRow.Delete
End Sub

Mike

 

[Lucile]

Exellent!! Thank you very much!

Hi,

Try this

Sub remove_decrease()
Dim RowNo As Long, lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
TheMax = WorksheetFunction.Max(Columns(1))
TheRow = Columns(1).Find(What:=TheMax, After:=Cells(1, 1)).Row
Range("A" & TheRow + 1 & ":A" & lastrow).ClearContents
End Sub

Mike

 

[Mike H]

Glad I could help

Exellent!! Thank you very much!