Deleteng Lines

[Eddie Wildon]

Good morning everyone

I have a toughie that, after about 2 hours, I cannot seem to solve.

I have a worksheet spanning 54000 lines and need to weed out most of it to get at what I really want.

Several of the lines contain identical data but I cannot simply sort it because I need to maintain names above data.

Is there a script that I can use to look at each line, and if it contains certain text to delete the whole line, and then move on to the next line, all that way to the end of the report?

This will maintain the order that the data is in, while removeing unwanted lines. Any help on this would be appreciated.

JCA

 

[calgaryguy]

Thanks! I'm not going to be able to give this a try until this weekend. I really appreciate the help!

 

[calgaryguy]

I just tried this and it sort of works. It worked opposite of what I thought it would. It deleted the empties in the sheet called "Original". I really wanted it to leave the original alone and delete in the sheet called "Holes Worksheet". This is how I changed the code.

Sub CopySheetAndDeleteCells()
Dim LastRow As Long
Dim Row As Long
Dim Column As Integer
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Holes Worksheet").Delete
Application.DisplayAlerts = True
Sheets("Original").Copy Before:=Sheets("Original")
Sheets("Original (2)").Name = "Holes Worksheet"
Sheets("Holes Worksheet").Activate
For Column = 2 To 20 Step 3
LastRow = Cells(65536, Column).End(xlUp).Row
For Row = LastRow To 3 Step -1
If Cells(Row, Column).Value = 0 Then
Range(Cells(Row, Column - 1), Cells(Row, Column + 1)).Delete Shift:=xlUp
End If
Next Row
Next Column
For Column = 25 To 43 Step 3
LastRow = Cells(65536, Column).End(xlUp).Row
For Row = LastRow To 3 Step -1
If Cells(Row, Column).Value = 0 Then
Range(Cells(Row, Column - 1), Cells(Row, Column + 1)).Delete Shift:=xlUp
End If
Next Row
Next Column
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


Thanks again for your help.

Ken

 

[Peter_SSs]

Ken

Where have you placed your code? If you have it within the particular Sheet code, move it to a separate Module. To do this:
1. From the menu in the VBA window, choose Insert|Module
2. Double click the newly inserted Module and move the code to that Module.

See how that goes.

 

[calgaryguy]

Thanks! That makes sense. Sorry, it is my lack of knowledge when it comes to VBA. I had it inserted into the sheet that I want to keep.

Ken

 

[calgaryguy]

So, I finally was able to spend some time to actually try this. It works well. Now, when I get to work tomorrow, I'll have to go through and put this code in all my files. Thanks again for your help.

Ken

 

[Norie]

Ken

Here's some other code that might be of interest though it would probably need to be adapted for your purposes.

Dim rng As Range

    Range("A1:I15").Replace What:="0", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Set rng = Range("A1:I15").SpecialCells(xlCellTypeBlanks)
    For Each rngArea In rng.Areas
        rngArea.Offset(, -1).Resize(, 3).Delete Shift:=xlUp
    Next