Delete Rows Based on the Value in Certain Column & Delete Columns For Only Some Rows

[excel6000]

I have a spreadsheet where there is already data in rows 3 through 39, with rows 1 and 2 being the headers. I will be copying and pasting from another spreadsheet where the amount of data (number of rows) will differ every time I do the copy.

I need to be able to run a macro which will only look at the data which I copy over (at the moment it is from row 40 downwards) and then within that data, I need to delete all rows which do not have "& Total" in column F. After this, I need to take the remaining data and delete columns F & G and shift everything over to the left. However, it should not delete any data above where I started copying from (at the moment it is from row 39 upwards).

Any help is much appreciated.

 

[Arithos]

Think I know whats up. since there is a r = r - 1 r might continue to go "downwards"

Sub Del_Lines_Div1()
Dim LR As Long
Dim TR As Long
Dim r As Integer
Dim s1 As WorksheetSet s1 = Sheets(1)
LR = s1.Cells(Rows.Count, "F").End(xlUp).Row
TR = InputBox("Please Enter the last row of the data you want to keep. In your example this is 39") + 1  
For r = TR To LR    If Cells(r, 6) = "& Total" Then    
Rows(r).Delete    r = r - 1    
[COLOR=#ff0000]if r < TR then goto continuation[/COLOR]   
 End If
Next r
[COLOR=#ff0000]continuation:
[/COLOR]LR = s1.Cells(Rows.Count, "F").End(xlUp).Row
Range(Cells(TR, 6), Cells(LR, 7)).Delete      [COLOR=#0000cd]
[/COLOR]Range("Q" & TR & ":BE" & LR).Delete         [COLOR=#ff0000]
[/COLOR]Range("BE" & TR & ":CB" & LR).DeleteEnd Sub

add these RED lines , didnt check it, but might be thats the problem.

 

[Arithos]

Nevermind, (I tested it)
Do this =)

its because it keeps trying to hit the LR number, and it keeps removing empty cells.

Hang on, I'll fix :D

 

[Arithos]

This fixes it for you, it kept going since it removed empty lines. trying to get to LR. This code will work aslong as all rows in COL "F" has a value aslong as there is something in the adjacent cells(toleft)

Sub Del_Lines_Div1()


Dim LR As Long
Dim TR As Long
Dim r As Integer
Dim s1 As Worksheet


Set s1 = Sheets(1)
LR = s1.Cells(Rows.Count, "F").End(xlUp).Row


TR = InputBox("Please Enter the last row of the data you want to keep") + 1


For r = LR To TR Step -1
    If Cells(r, 6) <> "& Total" Then
    Rows(r).Delete
    r = r - 1
    If Cells(r, 6) = "" Then GoTo continuation
    End If
Next r


continuation:


LR = s1.Cells(Rows.Count, "F").End(xlUp).Row
Range(Cells(TR, 6), Cells(LR, 7)).Delete
Range("M" & TR & ":BA" & LR).Delete
Range("N" & TR & ":AJ" & LR).Delete


End Sub

 

[excel6000]

Also, I wanted to know how to make the code stop if you hit cancel on the input box. I tried putting in:
If TR = 0 then end sub
but it gave me an error.

 

[mrmmickle1]

Use:

[COLOR=#0000ff]Exit Sub[/COLOR]

 

[Arithos]

ATTENTION!!


After consideration, I think this should be your goto Macro.. Sorry for all the FUZZ :S

Sub Del_Lines_Div1()


Dim LR As Long
Dim TR As Long
Dim r As Integer
Dim s1 As Worksheet


Set s1 = Sheets(1)
LR = s1.Cells(Rows.Count, "F").End(xlUp).Row


TR = InputBox("Please Enter the last row of the data you want to keep") + 1


For r = LR To TR Step -1
    If Cells(r, 6) <> "& Total" Then
    Rows(r).Delete
    End If
Next


LR = s1.Cells(Rows.Count, "F").End(xlUp).Row
Range(Cells(TR, 6), Cells(LR, 7)).Delete
Range("M" & TR & ":BA" & LR).Delete
Range("N" & TR & ":AJ" & LR).Delete
End Sub

Works like a charm on my end =)

 

[mrmmickle1]

Yes I see you removed.

r = r -1

and added the

[COLOR=#0000ff]Step[/COLOR] -1

I noticed this was an issue. The code got hung because it was evaluating the same r over and over again.....

 

[Arithos]

Also, I wanted to know how to make the code stop if you hit cancel on the input box. I tried putting in:
If TR = 0 then end sub
but it gave me an error.

If you want this then this could do it

Sub Del_Lines_Div1()
Dim LR As Long
Dim TR As Long
Dim r As Integer
Dim s1 As Worksheet


Set s1 = Sheets(1)
LR = s1.Cells(Rows.Count, "F").End(xlUp).Row


[COLOR=#ff0000]on error goto stahp   [/COLOR][COLOR=#0000ff] ' sets an errorhandling to react to no info in the inputbox[/COLOR]
TR = InputBox("Please Enter the last row of the data you want to keep") + 1
[COLOR=#ff0000]on error goto 0    [/COLOR][COLOR=#0000ff][/COLOR][COLOR=#0000ff]'sets the errorhandling back to normal[/COLOR]


For r = LR To TR Step -1
    If Cells(r, 6) <> "& Total" Then
    Rows(r).Delete
    End If
Next


LR = s1.Cells(Rows.Count, "F").End(xlUp).Row
Range(Cells(TR, 6), Cells(LR, 7)).Delete
Range("M" & TR & ":BA" & LR).Delete
Range("N" & TR & ":AJ" & LR).Delete


[COLOR=#ff0000]stahp:   [/COLOR][COLOR=#0000ff]you hopped here if no info in the inputbox =) and the macro ends and all is well in macro paradise[/COLOR]


End Sub

added red lines, if you press cancel on the Popup box the macro should just end

 

[Arithos]

Yes I see you removed.

r = r -1

and added the

[COLOR=#0000ff]Step[/COLOR] -1

I noticed this was an issue. The code got hung because it was evaluating the same r over and over again.....

Yep, should have implemented this from the start :S I got thrown off by the first code suggested here, and just tried to change it to work. I should have Created my own from the start =)

 

[excel6000]

WOW!!! Thank you Arithos and everyone who helped. It works like a charm on my end too now!! I LOVE THIS WEBSITE..... AND I LOVE EXCEL!!!!