Macro To Look At Specific Data In Cells And Delete Entire Rows

[Dazzawm]

I need a macro for something I do every day and I cant record it as it has different amounts everyday. I need the macro to look at column 'B' and any cell where the second digit is an R I need the entire row deleted. I then need it sorted smallest to largest by column 'D' (row 1 has headers).

Column D will then have values starting with a minus number gradually rising to positive numbers, I then need anything with a zero or higher those rows totally deleted, keeping the rows with a minus value in column 'D'.

The format of the data in column 'B' is normally 2 letters then 6 numbers i.e MR123456, JD456789, XX123456 etc...

Is this possible?

 

[VoG]

Maybe

Sub test()
Dim LR As Long, i As Long
LR = Range("B" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Mid(Range("B" & i).Value, 2, 1) = "R" Then Rows(i).Delete
Next i
Range("A1").CurrentRegion.Sort Key1:=Range("D1"), Order1:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

 

[Dazzawm]

Thanks VoG, almost there. It deletes the rows with the 'R' and then sorts column 'D' so the negatives are at the top. It doesn't however delete the rows that have a zero or positive number in 'D'. I know I can do that myself but it just needs a little tweak.

 

[VoG]

Sorry, I missed that bit. try

Sub test()
Dim LR As Long, i As Long
LR = Range("B" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Mid(Range("B" & i).Value, 2, 1) = "R" Then Rows(i).Delete
Next i
Range("A1").CurrentRegion.Sort Key1:=Range("D1"), Order1:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
LR = Range("D" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Range("D" & i).Value >= 0 Then Rows(i).Delete
Next i
End Sub

 

[Dazzawm]

Thanks, can it do just one more thing so I don't have to do anything! Once this has run can it then sort smallest to largest first by column 'G' then by column 'H' (inc headers in row 1) or can I record that bit and add it to the bottom?

Dont know if it makes a difference but the data may stretch as far as 'Z' so it will need to sort including all the columns inclusive.

 

[Dazzawm]

Thanks, can it do just one more thing so I don't have to do anything! Once this has run can it then sort smallest to largest first by column 'G' then by column 'H' (inc headers in row 1) or can I record that bit and add it to the bottom?

Dont know if it makes a difference but the data may stretch as far as 'Z' so it will need to sort including all the columns inclusive.

I did record it and added it on with the resulting code. Does it look ok?

I think I may have a problem though when I have different amounts of rows etc everyday.

Sub test()
Dim LR As Long, i As Long
LR = Range("B" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Mid(Range("B" & i).Value, 2, 1) = "R" Then Rows(i).Delete
Next i
Range("A1").CurrentRegion.Sort Key1:=Range("D1"), Order1:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
LR = Range("D" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Range("D" & i).Value >= 0 Then Rows(i).Delete
Next i
Cells.Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("G2:G3114" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("H2:H3114" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:N3114")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

[Dazzawm]

I think I done it, I just changed the range from 3114 to 10000, which should cover all eventualities.

 

[Dazzawm]

I have played around with the code you gave me and it seems to do what I need it to do. I don't what all the different parts mean but I sort of used my common sense and tweaked the code you gave me. Could you check it for me and tell me where I have gone wrong if I have. I am quite chuffed actually all part of the learning curve.

Sub test()
Dim LR As Long, i As Long
LR = Range("B" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Mid(Range("B" & i).Value, 2, 1) = "R" Then Rows(i).Delete
Next i
Range("A1").CurrentRegion.Sort Key1:=Range("D1"), Order1:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
LR = Range("D" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Range("D" & i).Value >= 0 Then Rows(i).Delete
Next i
LR = Range("G" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
If Range("G" & i).Value > 0 Then Rows(i).Delete
LR = Range("H" & Rows.Count).End(xlUp).Row
If Range("H" & i).Value > 0 Then Rows(i).Delete
LR = Range("C" & Rows.Count).End(xlUp).Row
If Range("C" & i).Value = "NPPACK" Then Rows(i).Delete
If Range("C" & i).Value = "EXPOSTER" Then Rows(i).Delete
If Range("C" & i).Value = "GYREGISTER" Then Rows(i).Delete
If Range("C" & i).Value = "INFOSHEET" Then Rows(i).Delete
    Next
End Sub

 

[Ropes4u]

ASAP Utilities might work for you I use it on a fairly regular basis and am amazed at the number of things it can do. It is always loaded in the menu and has a conditional delete feature.

 

[Dazzawm]

ASAP Utilities might work for you I use it on a fairly regular basis and am amazed at the number of things it can do. It is always loaded in the menu and has a conditional delete feature.

Sorry not come across those or know what they are.