Macro to delete rows

[Hankjam]

Hello

I would like a macro that deal with this task.

I have Range from A1:H385.

After sorting, a number of rows will have 999 in AX, BX and CX.

The number of rows with this condition will vary, depending on how
busy the process is going to be.

I would like a macro to delete these and from Row386 to Row500.

Many thanks for your time.

Aj

 

[Mike H]

Hi,

In your message header you ask to delete rows and in the body of the message
you seem to say delete the values. This does the latter. Right click your
sheet tab, vuew code and paste this in and run it

Sub stance()
Dim MyRange
Dim copyrange As Range
Set MyRange = Range("AX386:AX500")
For Each c In MyRange
If c.Value = 999 And c.Offset(, 26).Value = 999 And c.Offset(, 52).Value =
999 Then
Set copyrange = Union(c, c.Offset(, 26), c.Offset(, 52))
copyrange.ClearContents
Set copyrange = Nothing

End If
Next
End Sub

Mike

 

[Hankjam]

Arrgghh

Sorry. I meant to delete the rows...

I'll give this a go and see what happens

Many thank Mike

Aj

 

[Hankjam]

Hi,

In your message header you ask to delete rows and in the body of the message
you seem to say delete the values. This does the latter. Right click your
sheet tab, vuew code and paste this in and run it

Sub stance()
Dim MyRange
Dim copyrange As Range
Set MyRange = Range("AX386:AX500")
For Each c In MyRange
If c.Value = 999 And c.Offset(, 26).Value = 999 And c.Offset(, 52).Value =
999 Then
Set copyrange = Union(c, c.Offset(, 26), c.Offset(, 52))
copyrange.ClearContents
Set copyrange = Nothing

End If
Next
End Sub

Mike

Hi

Got some Syntax error on the line:

If c.Value = 999 And c.Offset(, 26).Value = 999 And c.Offset(,
52).Value = 999

The range of the Data is A1:H385

Rows 102 to 385 have 999 in columns A

It is these rows and those from 386 to 500, which are empty I want to
delete.

The starting row with 999 in column A can vary.

Thank you

Andrew

 

[Mike H]

Use this to delete the entire row

Sub stance()
Dim MyRange
Dim copyrange As Range
Set MyRange = Range("AX386:AX500")
For Each c In MyRange
If c.Value = 999 And c.Offset(, 26).Value = 999 And c.Offset(, 52).Value =
999 Then
If copyrange Is Nothing Then
Set copyrange = c.EntireRow
Else
Set copyrange = Union(copyrange, c.EntireRow)
End If

If Not copyrange Is Nothing Then
copyrange.Delete
End If

Mike