Recorded macro assistance for deleting data for specific rows

[Bimmy]

Hi.

I have a recorded macro which -

1) Sorts data in ascending order
2) Splits data (Text to Columns)
3) Deletes few columns
4) Remove duplicates as per column B
5) Cut and pastes column A data to column C, and
6) Copies data from Column B and C, and paste them in sheet2 in Range E4

The recorded macro is assigned to button "02nd Run" in the attached sheet.

Below is the code -

Sub Macro1()
'
' Macro1 Macro
'

'
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(4, 1), Array(7, 1), Array(25, 1), Array(31, 1)), _
        TrailingMinusNumbers:=True
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("A:B").Select
    Range("B1").Activate
    ActiveSheet.Range("$A$1:$B$3000").RemoveDuplicates Columns:=2, Header:=xlNo
    Columns("A:A").Select
    Selection.Cut Destination:=Columns("C:C")
    Range("B1:C3000").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Range("E4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G4").Select
    Application.CutCopyMode = False
End Sub

Assistance required for -

There are few manual steps that I do before the macro is run. Don't know how to record or write macro for the manual steps.

Manual steps involved -

1) Insert 111111111 in Cell A1 on Sheet1
2) Paste data on Cell A2 on Sheet1
3) Auto fit the pasted data
4) Highlight column A, click Data and click A to Z sort option
5) In the attached sheet after doing above 4 steps, start row will be 45
and end row will be 89

On sheet1 in cell M2 and M3, user will enter start and end row details.I have inserted a
command button "01st Run".The idea is when users click on the command button 01st Run macro should do as below -

Start Row -

If user enters start row as 45 macro should select row 45 and move upwards till row 1 and delete the selected rows.

End Row -

If user enters end row as 89 macro should select row 89 and move 500 rows down and delete the selected rows.

Depending on the start and end row details entered macro should perform above mentioned task.

Note -

If users does not enter data for start or end row macro should give a prompt -
"Please enter data"

 

[Bimmy]

Hi,

After test recording macro for the past few days I need assistance with one step explained below -

Start row always contain keyword " ****min " and
End row always contain keyword " outbound "

Can macro look for keyword "****min" and select the respective row and move upwards till row 1 and delete the entire rows selected.

Similarly, macro should look for keyword "outbound" and select the respective row and move 500 rows downwards and delete the entire rows selected.

Your assistance will be greatly appreciated.

Have attached sample sheet.

 

[Marc L]

Hi !

You could start yourself with Excel search function and Macro Recorder !

Try this demonstration :​

Sub Demo1()
       Dim Rg As Range, B%
       Application.ScreenUpdating = False
With Sheet1.UsedRange.Resize(, Sheet1.UsedRange.Columns.Count + 1).Columns
       .Item(.Count).Value = 0
       Set Rg = .Item(1).Find(" min ", , , xlPart, , , True)
    If Not Rg Is Nothing Then B = 1: .Item(.Count).Rows("1:" & Rg.Row).Value = 1
       Set Rg = .Item(1).Find(" OUTBOUND ", , , xlPart, , , True)
    If Not Rg Is Nothing Then B = 1: .Item(.Count).Rows(Rg.Row & ":" & .Rows.Count).Value = 1
If B Then
       Set Rg = Nothing
    .Sort .Cells(.Count), xlAscending, Header:=xlNo
    .Rows(.Item(.Count).Find(1, .Cells(.Rows.Count, .Count)).Row & ":" & .Rows.Count).Clear
End If
       .Item(.Count).Clear
End With
       Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Marc L]

A formula way (FALSE / TRUE instead of 0 / 1) :​

Sub Demo2()
     Const F = "=OR(ROW()<=MATCH(""* min *"",#,0),ROW()>=MATCH(""* OUTBOUND *"",#,0))"
     Application.ScreenUpdating = False
With Sheet1.UsedRange.Resize(, Sheet1.UsedRange.Columns.Count + 1).Columns
    .Item(.Count).Formula = Replace$(F, "#", .Item(1).Address)
    .Item(.Count).Formula = .Item(.Count).Value
    .Sort .Cells(.Count), xlAscending, Header:=xlNo
    V = Application.Match(True, .Item(.Count), 0)
    If IsError(V) Then .Item(.Count).Clear Else Union(.Rows(V & ":" & .Rows.Count), .Item(.Count)).Clear
End With
     Application.ScreenUpdating = True
End Sub

You may Like it !
​

 

[Marc L]

Any news ?!

Anyway for potential readers, last but not least,
another formula way back to 0 / 1 but direct and my favorite :​

Sub Demo3()
     Const F = "=--(ROW(#1)<=#2)--(ROW(#1)>=#3)"
     Dim A$, V, W
     Application.ScreenUpdating = False
With Sheet1.UsedRange.Resize(, Sheet1.UsedRange.Columns.Count + 1).Columns
    A = .Item(1).Address(, , , True)
    V = Application.Match("* min *", .Item(1), 0):       If IsError(V) Then V = 0
    W = Application.Match("* OUTBOUND *", .Item(1), 0):  If IsError(W) Then W = .Rows.Count + 1
    .Item(.Count).Value = Evaluate(Replace$(Replace$(Replace$(F, "#1", A), "#2", V), "#3", W))
    .Sort .Cells(.Count), xlAscending, Header:=xlNo
    V = Application.Match(1, .Item(.Count), 0)
    If IsError(V) Then .Item(.Count).Clear Else Union(.Rows(V & ":" & .Rows.Count), .Item(.Count)).Clear
End With
     Application.ScreenUpdating = True
End Sub

You should Like it !
​

 

[Bimmy]

Hi Marc L,

I have tested all 3 codes and it works PERFECTLY.

Many thanks for your TIME and Codes...